Detectar a abertura do Internet Explorer.

Delphi

22/04/2004

Amigos,
como faço para detectar a abertura do internet explorer? Eu quero que o meu programa execute uma rotina assim que ele for aberto.


Orlando Frade

Orlando Frade

Curtidas 0

Respostas

Beppe

Beppe

22/04/2004

Existe uma interface que você implementa para interceptar as chamadas à ShellExecute(Ex). Chama-se IShellExecuteHook. Eu já a implementei com sucesso, mas agora olhando no SDK eu não achei referências de como registrá-la no shell, e eu nunca vou achar aqui meus fontes.

O método Execute da interface é chamado cada vez que um programa está para ser aberto via a shell. Basta colocar seu código lá dentro, testando se iexplore.exe foi aberto.

No meu SDK(PSDK February 2003) não tem, mas tenho quase certeza que no SDK antigo(esse q vem com o Delphi) deva ter. Procura por essa função lá.


GOSTEI 0
Beppe

Beppe

22/04/2004

Por um acaso, achei aqui meu projeto. Não sei se tu ainda precisa, mas pode servir para alguém...

O esquema é implementar um objeto COM(TAutoObject) em uma dll, e registrá-lo.

// Escrito por Beppe
// 28/06/02
unit Main;

interface

uses
  Windows, ActiveX, Classes, ComObj, DelphiShellHook_TLB, StdVcl, ShellApi,
  ShlObj, SysUtils, Registry, ComConst;

type
  TDelphiShellHook = class(TAutoObject, IDelphiShellHook, IShellExecuteHook)
  protected
    function Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult; stdcall;
    {Declare IDelphiShellHook methods here}
  end;

  THookFactory = class(TAutoObjectFactory)
  protected
    procedure ApproveShellExtension(Register: Boolean; const CLSID: String);
    function GetProgID: String; override;
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

implementation

uses ComServ;

{ TDelphiShellHook }

function TDelphiShellHook.Execute(
  var ShellExecuteInfo: TShellExecuteInfo): HResult;
var
  S: TStrings;
begin
  Result := S_OK;
  S := TStringList.Create;
  try
    S.LoadFromFile(´C:\ShExecHook.txt´);
    S.Add(ShellExecuteInfo.lpFile);
    S.SaveToFile(´C:\ShExecHook.txt´);
  finally
    S.Free;
  end;
end;

{ THookFactory }

procedure THookFactory.ApproveShellExtension(Register: Boolean;
  const CLSID: String);
const
  SApproveKey = ´SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved´;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey(SApproveKey, True) then
      if Register then
        WriteString(ClsID, Description)
      else
        DeleteValue(ClsID);
  finally
    Free;
  end;
end;

function THookFactory.GetProgID: String;
begin
  Result := ´´;
end;

procedure CreateRegKey(const Key, ValueName, Value: String);
var
  Handle: HKey;
  Status, Disposition: Integer;
begin
  Status := RegCreateKeyEx(HKEY_LOCAL_MACHINE, PChar(Key), 0, ´´,
    REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle,
    @Disposition);
  if Status = 0 then
  begin
    Status := RegSetValueEx(Handle, PChar(ValueName), 0, REG_SZ,
      PChar(Value), Length(Value) + 1);
    RegCloseKey(Handle);
  end;
  if Status <> 0 then raise EOleRegistrationError.CreateRes(@SCreateRegKeyError);
end;

procedure DeleteRegValue(const Key, Value: String);
var
  Handle: HKey;
begin
  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(Key), 0, KEY_ALL_ACCESS,
    Handle) = ERROR_SUCCESS then
  begin
    RegDeleteValue(Handle, PChar(Value));
    RegCloseKey(Handle);
  end;
end;

procedure THookFactory.UpdateRegistry(Register: Boolean);
const
  SShellHooks = ´SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks\´;
var
  CLSID: String;
begin
  inherited UpdateRegistry(Register);
  CLSID := GUIDToString(ClassID);
  ApproveShellExtension(Register, CLSID);
  if Register then
    CreateRegKey(SShellHooks, SID_IShellExecuteHookA, CLSID)
  else
    DeleteRegValue(SShellHooks, SID_IShellExecuteHookA);
end;

initialization
  THookFactory.Create(ComServer, TDelphiShellHook, Class_DelphiShellHook,
    ciMultiInstance, tmApartment);
end.


PS: Lembro que tinha removido a parte de bloquear programas, pq estava me criando problemas(os programas não abriam, óbvio). Acho que seria Result := S_FAIL; para bloquear, no método execute.


GOSTEI 0
POSTAR