Форум: "Основная";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Вниз

Помогите создать COM-объект   Найти похожие ветки 

← →
oleg_SYS ©   (2005-10-09 20:40) [0]

Помогите создать COM-объект

Мне необходимо добавить новый пункт в контекстное меню, появляющееся после нажатия правой кнопкой в окне IE, который бы запускал мою программу.
Т.е. добавить новый раздел в реестре:


HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt


Но в качестве команд нельзя указывать путь к EXE-файлу. Можно только запустить скрипт (*.js). Чтобы скрипт запустил мою программу (как это делает FlashGet или ReGet) нужно создать новый интерфейс, создать новый метод Run (запуск моего exe-файла) и зарегистрирывать его в системе.


<script language="VBScript">
set MyClassFactory=CreateObject("IMyClassFactory")
IMyClassFactory.Run
</script>


Я создал новую ActiveX libary:


library Project1;

uses
 ComServ,
 DelphCom; // модуль DelphCom.pas

exports
 DllGetClassObject,
 DllCanUnloadNow,
 DllRegisterServer,
 DllUnregisterServer;

{$R *.RES}

begin
end.


и попробывал в uses прикрипить модуль DelphCom (который я взял из этой статьи: http://alex-co.narod.ru/Delphi/Documents/Papers/com_objects.html).  Но он не компилируется (не находит файл ole2.dcu и не понимает многие типы и констатнты).


unit DelphCom;
// "Обобщенные" объекты. Предназначены для создания COM-объектов
// в Delphi. ISatelliteUnknown - интерфейсный объект, который
// будет обслуживаться через IContainerUnknown. Любой реальный
// COM-объект с несколькими интерфейсами
// будет наследоваться из IContainerUnknown и содержать
// функцию QueryInterface.
USES Windows, Ole2, Classes, SysUtils, ShellApi, ShlObj;
VAR DllRefCount : Integer;
type
 IContainerUnknown = class;
 ISattelliteUnknown = class(IUnknown)
 // Этот интерфейс будет обслуживаться через IContainerUnknown.
 // Отображает три IUnknown-функции на свой объект-контейнер.
 protected
 fContainer : IContainerUnknown;
public
 constructor Create(vContainer : IContainerUnknown);
 function QueryInterface(const WantIID: TIID;
   var ReturnedObject): HResult; override;
 function AddRef: Longint; override;
 function Release: Longint; override;
end;
IContainerUnknown = class (IUnknown)
protected
 FRefCount : Integer;
public
 Constructor Create;
 destructor Destroy; override;
 (IUnknown-функции)
 function QueryInterface(const WantIID: TIID;
   var ReturnedObject): HResult; override;
 function AddRef: LongInt; override;
 function Release: LongInt; override;
end;
IMyClassFactory = Class(IClassFactory)
private
 FRefcount : Integer;
public
 constructor Create;
 destructor Destroy; override;
 function QueryInterface(const WantIID: TIID;
   var ReturnedObject): HResult; override;
 function AddRef: LongInt; override;
 function Release: LongInt; override;
 // В дочернем объекте должно быть дано определение
 // для функции CreateInstance
 function LockServer(fLock: BOOL):
     HResult; override;
end;
function DLLCanUnloadNow : HResult; StdCall; Export;
implementation
(****** ISatelliteUnknown *****)
constructor ISatelliteUnknown.Create(vContainer:
   IContainerUnknown);
begin
 fContainer := vContainer;
end;
function ISatelliteUnknown.QueryInterface(const WantIID: TIID;
   var ReturnedObject): HResult;
begin
 Result := fContainer.QueryInterface(WantIid,
     ReturnedObject);
end;
function ISatelliteUnknown.AddRef: LongInt;
begin
 Result := fContainer.AddRef;
end;
function ISatelliteUnknown.Release: LongInt;
begin
 Result := fContainer.Release;
end;
(****** IContainerUnknown ******)
constructor  IContainerUnknown.Create;
begin
 Inherited Create;
 FRefCount := 0;
 Inc(DllRefCount);
end;
destructor IContainerUnknown.Destroy;
begin
 Dec(DllRefCount);
 Inherited Destroy;
end;
function IContainerUnknown.QueryInterface(const WantIID: TIID;
   var ReturnedObject): HResult;
VAR P : IUnknown;
begin
 If IsEqualIID(WantIID, IID_IUnknown) THEN P := Self
 ELSE P:= nil;
 Pointer(ReturnedObject) := P;
 IF P = NIL THEN Result := E_NOINTERFACE
 ELSE
   begin
     P.AddRef;
     Result := S_OK;
   end;
end;
function IContainerUnknown.AddRef: LongInt;
begin
 Inc(FRefCount);
 Result := FRefCount;
end;
function IContainerUnknown.Release: LongInt;
begin
 Dec(FRefCount);
 Result := FRefCount;
 IF FRefCount = 0 THEN Free;
end;
(****** IMyClassFactory ******)
constructor IMyClassFactory.Create;
begin
 Inherited Create;
 Inc(DllRefCount);
 FRefCount := 0;
end;
destructor IMyClassFactory.Destroy;
begin
 Dec(DllRefCount);
 Inherited Destroy;
end;
function IMyClassFactory.QueryInterface(const WantIID: TIID;
   var ReturnedObject): HResult;
begin
 If IsEqualIID(WantIiD, IID_IUnknown) OR
     IsEqualIID(WantIiD, IID_IClassFactory) THEN
   begin
     Pointer(ReturnedObject) := Self;
     AddRef;
     Result := S_OK;
   end
 ELSE
   begin
     Pointer(ReturnedObject) := NIL;
     Result := E_NOINTERFACE;
   end
end;
function IMyClassFactory.AddRef: LongInt;
begin
 Inc(FRefCount);
 Result := FRefCount;
end;
function IMyClassFactory.Release: LongInt;
begin
 Dec(FRefCount);
 Result := FRefCount;
 IF FRefCount = 0 THEN Free;
end;
function IMyClassFactory.LockServer(fLock: Bool):HResult;
begin
 Result := E_NOTIMPL;
end;
(****** экспортируемая функция ******)
function DLLCanUnloadNow: hResult; StdCall; Export;
begin
 IF DllRefCount = 0 THEN Result := S_OK
 ELSE                    Result := S_FALSE;
end;
initialization
 DllRefCount := 0;
end.


---

← →
REA   (2005-10-10 11:01) [1]

Вероятно надо добавить Automation object в Library:
Use the New Automation Object wizard to add an Automation server to an ActiveX Library project.
Насчет примера ничего не могу сказать - по-моему это вообще из другой оперы.

---

← →
Leonid Troyanovsky ©   (2005-10-10 11:15) [2]

> oleg_SYS ©   (09.10.05 20:40)  

> Но в качестве команд нельзя указывать путь к EXE-файлу.


  Demos\ActiveX\ShellExt\contmenu.dpr

--
Regards, LVT.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.038 c