Опытный
Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург
Репутация: 1
Всего: 6
|
Добрый день. Диплом горит! У меня Add-ins к ворду. Делал все по Тенцеру, ни чего лишнего, все как у Тенцера. Когда закрываю Word дебугер ловит access vilation at 0x000000000. Дело именно в проекте, ошибка повторяеться в раных системах. Может у кого то, что то подобное было? В чем может быть проблема? И почему у Тенцера на ondisconnect удаляется только кнопка, а панель остаеться? Вот код: | Код |
unit ComServerUnit;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, ErQR_TLB,Variants,Word_TLB,
Office_TLB,ComAddinUtils, MacrosUnit;
type
TDEwinReport = class(TAutoObject, IDTExtensibility2)
private
Host: WordApplication;
FButtonEventsSink: TCommandButtonEventSink;
Bar: CommandBar;
Button: CommandBarButton;
MacrosObj:TInterpreter;
procedure ButtonClick(Button: CommandBarButton;
var CancelDefault: WordBool);
protected
procedure BeginShutdown(var custom: PSafeArray); safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnConnection(const HostApp: IDispatch; ext_ConnectMode: Integer;
const AddInInst: IDispatch; var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer; var custom: PSafeArray);
safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;
end;
const
BUTTON_TAG = '{F3C838C9-D661-468B-9045-E96DE887D32E}';
implementation
uses ComServ,ShlObj,Windows,SysUtils;
procedure TDEwinReport.BeginShutdown(var custom: PSafeArray);
begin
end;
procedure TDEwinReport.OnAddInsUpdate(var custom: PSafeArray);
begin
end;
procedure TDEwinReport.OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch; var custom: PSafeArray);
const msoBarFloating = 4;
//const msoControlComboBox = 4;
begin
// MacrosObj := TInterpreter.Create;
// MacrosObj.Destroy;
// Сохраняем ссылку на WordApplication
Host := HostApp as WordApplication;
// Создаем обработчик событий для кнопки
FButtonEventsSink := TCommandButtonEventSink.Create;
FButtonEventsSink.OnClick := ButtonClick;
// Создаем панельку
Bar := Host.CommandBars.Add('ErWin AddIns panel',msoBarFloating,False,True);
Bar.Enabled:=true;
Bar.Visible:=true;
//Bar.Controls.Add( msoControlComboBox, 1,EmptyParam,EmptyParam,EmptyParam);
// Проверяем наличие на ней нашей кнопки
Button := Bar.FindControl(msoControlButton, EmptyParam, BUTTON_TAG,
EmptyParam, msoFalse) as CommandBarButton;
if not Assigned(Button) then
// Если её нет - создаем
Button := Bar.Controls.Add(msoControlButton, EmptyParam,
BUTTON_TAG, 1, EmptyParam) as CommandBarButton;
// Подключаем обработчик и устанавливаем свойства кнопки
FButtonEventsSink.Connect(Button);
Button.Set_Style(msoButtonIconAndCaption);
Button.Set_Tag(BUTTON_TAG);
Button.Set_FaceId(43);
Button.Set_Caption('Connect to ErWin');
// MacrosObj.GlobalModelName:='_';
end;
procedure TDEwinReport.OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray);
var
Bar: CommandBar;
B: CommandBarControl;
begin
// Уничтожаем обработчик событий кнопки
FreeAndNil(FButtonEventsSink);
// Ищем свою кнопку
Bar := Host.CommandBars.Get_Item('ErWin AddIns panel');
B := Bar.FindControl(msoControlButton, EmptyParam, BUTTON_TAG,
EmptyParam, msoFalse) as CommandBarButton;
// И удаляем ее
if Assigned(B) then
B.Delete(msoFalse);
//Bar.Delete;}
end;
procedure TDEwinReport.OnStartupComplete(var custom: PSafeArray);
begin
end;
procedure TDEwinReport.ButtonClick(Button: CommandBarButton;
var CancelDefault: WordBool);
var
D: WordDocument;
Patch: OleVariant;
FErWinDocName, FWordDocName: string;
WordBool:OleVariant;
// timer:Itimer
begin
//Patch:=Host.NormalTemplate.Path + '\ErWinTemplate1.dot';
MessageBox(0,'hi!','mm',mb_Ok);
{if MacrosObj.GetFileNameFromBrowse(0, FWordDocName, 'c:\', '*.doc',
'Файлы MSWord '#0'*.doc'#0'Все файлы'#0'*.*'#0#0 , 'Выбор файла MsWord') then
Patch:=FWordDocName else
begin
MessageBox(0,'Не выбран файл','Внимание!',MB_ICONWARNING);
exit;
end;
WordBool := true;
d:= Host.Documents.Add(Patch, EmptyParam, EmptyParam, WordBool);
//Host.Documents.AddOld(Patch, EmptyParam);
if MacrosObj.GetFileNameFromBrowse(0, FErWinDocName, 'c:\', '*.er1',
'Файлы ERwin '#0'*.er1'#0'Все файлы'#0'*.*'#0#0 , 'Выбор файла ErWin') then
begin
MacrosObj.GlobalModelName := '_';
d.Application.Visible := false;
//MacrosObj.MSWordMacros(D,PAnsiChar(FErWinDocName),host);
MacrosObj.MSWordMacrosVer2(D,PAnsiChar(FErWinDocName),host);
//MacrosObj.MSWordMacrosTest(D,PAnsiChar(FErWinDocName),host);
d.Application.Visible := true;
d.Activate;
end;
}
end;
initialization
TAutoObjectFactory.Create(ComServer, TDEwinReport, Class_TDTExtensibility2,
ciMultiInstance, tmApartment);
end.
|
| Код |
{
Вспомогательные функции для реализации интерфейса IDispatch
Реализация интерфейса с Ms.Word
}
unit ComAddInUtils;
interface
uses ActiveX, Office_TLB, ComObj, SysUtils, Windows;
type
TBaseSink = class(TObject, IUnknown, IDispatch)
protected
{ методы IUnknown }
function QueryInterface(const IID: TGUID; out Obj): HResult;
stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ методы IDispatch }
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
virtual; stdcall;
function GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult; virtual; stdcall;
function GetTypeInfoCount(out Count: Integer): HResult;
virtual; stdcall;
function Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
virtual; stdcall;
private
FCookie: Integer;
FCP: IConnectionPoint;
FSinkIID: TGuid;
FSource: IUnknown;
function DoInvoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var dps: TDispParams;
pDispIds: PDispIdList; VarResult, ExcepInfo,
ArgErr: Pointer): HResult; virtual; abstract;
public
destructor Destroy; override;
procedure Connect(pSource : IUnknown);
procedure Disconnect;
property SinkIID: TGuid read FSinkIID;
property Source: IUnknown read FSource;
end;
//------------------------------------------------------------------------------
type
_CommandBarButtonEvents = dispinterface
['{000C0351-0000-0000-C000-000000000046}']
procedure Click(const Ctrl: CommandBarButton;
var CancelDefault: WordBool); dispid 1;
end;
type
// Обработчик события нажатия на кнопку
TOnCommandButtonClick = procedure (Button: CommandBarButton;
var CancelDefault: WordBool) of object;
TCommandButtonEventSink = class(TBaseSink)
private
FOnClick: TOnCommandButtonClick;
protected
procedure DoClick(Button: CommandBarButton;
var CancelDefault: WordBool); virtual;
function DoInvoke (DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var dps : TDispParams;
pDispIds : PDispIdList; VarResult, ExcepInfo,
ArgErr: Pointer): HResult; override;
public
constructor Create; virtual;
property OnClick: TOnCommandButtonClick
read FOnClick write FOnClick;
end;
implementation
{===============================================================================
START of BaseSink realization}
function TBaseSink.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
Result := E_NOINTERFACE;
Pointer(Obj) := NIL;
if GetInterface(IID, Obj) then
Result := S_OK;
// если запрашивается интерфейс SinkIID -
// возвращаем свой IDispatch
if not Succeeded(Result) then
if IsEqualIID(IID, FSinkIID) then
if GetInterface(IDispatch, Obj) then
Result := S_OK;
end;
procedure TBaseSink.Connect(pSource: IUnknown);
var
pcpc: IConnectionPointContainer;
begin
Disconnect;
try
// Запрашиваем интерфейс IConnectionPointContainer у объекта-
// источника событий
OleCheck(pSource.QueryInterface(IConnectionPointContainer,
pcpc));
// Запрашиваем интерфейс IConnectionPoint.
OleCheck(pcpc.FindConnectionPoint(FSinkIID, FCP));
// Подключаемся к обработчику событий
OleCheck(FCP.Advise(Self, FCookie));
// Все прошло успешно - устанавливаем свойство Source
FSource := pSource;
except
raise Exception.Create(Format('Unable to connect %s.'#13'%s',
[ClassName, Exception(ExceptObject).Message]));
end;
end;
procedure TBaseSink.Disconnect;
begin
if FSource = NIL then
Exit;
try
OleCheck(FCP.Unadvise(FCookie));
FCP := NIL;
FSource := NIL;
except
Pointer(FCP) := NIL;
Pointer(FSource) := NIL;
end;
end;
function TBaseSink._AddRef: Integer;
begin
Result := 2;
end;
function TBaseSink._Release: Integer;
begin
Result := 1;
end;
function TBaseSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TBaseSink.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
pointer (TypeInfo) := NIL;
end;
function TBaseSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
Count := 0;
end;
procedure BuildPositionalDispIds (pDispIds : PDispIdList; const dps : TDispParams);
var
i : integer;
begin
Assert (pDispIds <> NIL);
{ меняем местами аргументы }
for i := 0 to dps.cArgs - 1 do
pDispIds^ [i] := dps.cArgs - 1 - i;
{ проверка на непустые аргументы }
if (dps.cNamedArgs <= 0) then Exit;
{ обработка аргументов }
for i := 0 to dps.cNamedArgs - 1 do
pDispIds^ [dps.rgdispidNamedArgs^ [i]] := i;
end;
//
function TBaseSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
dps : TDispParams absolute Params;
bHasParams : boolean;
pDispIds : PDispIdList;
iDispIdsSize : integer;
begin
//do you still believe?
if (Flags AND DISPATCH_METHOD = 0) then
raise Exception.Create (
Format ('%s only supports sinking of method calls!', [ClassName]
));
pDispIds := NIL;
iDispIdsSize := 0;
bHasParams := (dps.cArgs > 0);
if (bHasParams) then
begin
iDispIdsSize := dps.cArgs * SizeOf (TDispId);
GetMem (pDispIds, iDispIdsSize);
end;
try
{ rearrange dispids properly }
if (bHasParams) then BuildPositionalDispIds (pDispIds, dps);
Result := DoInvoke (DispId, IID, LocaleID, Flags, dps, pDispIds, VarResult, ExcepInfo, ArgErr);
finally
{ free pDispIds array }
if (bHasParams) then FreeMem (pDispIds, iDispIdsSize);
end; { finally }
end;
destructor TBaseSink.Destroy;
begin
Disconnect;
inherited;
end;
{END of BaseSink realization
===============================================================================}
{===============================================================================
START of CommandBarButton realization}
constructor TCommandButtonEventSink.Create;
begin
inherited;
FSinkIID := _CommandBarButtonEvents;
end;
procedure TCommandButtonEventSink.DoClick(Button: CommandBarButton;
var CancelDefault: WordBool);
begin
if Assigned(FOnClick) then
FOnClick(Button, CancelDefault);
end;
function TCommandButtonEventSink.DoInvoke(DispID: Integer;
const IID: TGUID; LocaleID: Integer; Flags: Word;
var dps: TDispParams; pDispIds: PDispIdList;
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
Result := S_OK;
case DispID of
// Для этого DispId передаются 2 параметра - CommandBarButton
// и WordBool
1 : DoClick(IUnknown(dps.rgvarg^[pDispIds^[0]].unkVal)
as CommandBarButton, dps.rgvarg^[pDispIds^[1]].pbool^);
else
Result := DISP_E_MEMBERNOTFOUND;
end;
end;
{END of CommandBarButton realization
===============================================================================}
end.
|
Точнее, ошибку выдает при выгрузке модуля. Причем фатальную для ворда. Это сообщение отредактировал(а) cemick - 18.5.2007, 01:04 |
Word при закрытие выдает access violation, Add-ins в Word 
Загрузка ...
