Создание ВК с несколькими объектами

1. Hadgehogs 495 03.02.08 11:34 Сейчас в теме
Здравствуйте. Вот уже 2 недели блин бьюсь с этой проблемой - сейчаст опять не получилось. Очень зол.
ЗагрузитьВнешнююКомпоненту("testvk.dll");
ВК=СоздатьОбъект("Addin.new");
ВК1=СоздатьОбъект("Addin.new1"); //Вот здесь говорит, что тип необнаружен

текст в Дельфи
unit AddInObj;

interface

uses { Êàêèå áèáëèîòåêè èñïîëüçóåì }
ComServ, ComObj, ActiveX, SysUtils, Windows, AddInLib, vk_object,dialogs;

(*1*)
const c_AddinName = 'new'; //Èìÿ âíåøíåé êîìïîíåíòû
const c_AddinName1 = 'new1';
////////////////////////////////////////////////////////////­////////////
//Êîëè÷åñòâî ñâîéñòâ
const c_PropCount = 5; (*2*)

//Èäåíòèôèêàòîðû ñâîéñòâ
type TProperties = (
prop1,
prop2,
prop3,
prop4,
prop5
);

////////////////////////////////////////////////////////////­////////////
//Êîëè÷åñòâî ìåòîäîâ
const c_MethCount = 5; (*3*)
//Èäåíòèôèêàòîðû ìåòîäîâ.
type TMethods = (
meth1,
meth2,
meth3,
meth4,
meth5
);

////////////////////////////////////////////////////////////­////////////
const
//Íàæìèòå Ctrl-Shift-G, ÷òîáû ñãåíåðèðîâàòü íîâûé óíèêàëüíûé èäåíòèôèêàòîð CLSID
//âíåøíåé êîìïîíåíòû.
(*4*)
CLSID_AddInObject : TGUID = '{CE4FB6DB-636C-4824-86C4-DCE02135FE5A}';
CLSID_AddInObject1 : TGUID = '{1388D92A-1A62-449F-BC0B-462B1E26DAFB}';


////////////////////////////////////////////////////////////­////////////
type

AddInObject = class(TComObject, IDispatch, IInitDone, ILanguageExtender)

public
i1cv7: IDispatch;
iStatus: IStatusLine;
iExtWindows: IExtWndsSupport;
iError: IErrorLog;
iEvent : IAsyncEvent;
protected


//Ïåðåìåííàÿ îáúåêòà âíåøíåé êîìïîíåíòû
vk_object: T_vk_object;


{ IInitDone implementation }
function Init(pConnection: IDispatch): HResult; stdcall;
function Done: HResult; stdcall;
function GetInfo(var pInfo: PSafeArray): HResult; stdcall;

{ ILanguageExtender implementation }
function RegisterExtensionAs(var bstrExtensionName: WideString): HResult; stdcall;
function GetNProps(var plProps: Integer): HResult; stdcall;
function FindProp(const bstrPropName: WideString; var plPropNum: Integer): HResult; stdcall;
function GetPropName(lPropNum, lPropAlias: Integer; var pbstrPropName: WideString): HResult; stdcall;
function GetPropVal(lPropNum: Integer; var pvarPropVal: OleVariant): HResult; stdcall;
function SetPropVal(lPropNum: Integer; var varPropVal: OleVariant): HResult; stdcall;
function IsPropReadable(lPropNum: Integer; var pboolPropRead: Integer): HResult; stdcall;
function IsPropWritable(lPropNum: Integer; var pboolPropWrite: Integer): HResult; stdcall;
function GetNMethods(var plMethods: Integer): HResult; stdcall;
function FindMethod(const bstrMethodName: WideString; var plMethodNum: Integer): HResult; stdcall;
function GetMethodName(lMethodNum, lMethodAlias: Integer; var pbstrMethodName: WideString): HResult; stdcall;
function GetNParams(lMethodNum: Integer; var plParams: Integer): HResult; stdcall;
function GetParamDefValue(lMethodNum, lParamNum: Integer; var pvarParamDefValue: OleVariant): HResult; stdcall;
function HasRetVal(lMethodNum: Integer; var pboolRetValue: Integer): HResult; stdcall;
function CallAsProc(lMethodNum: Integer; var paParams: PSafeArray): HResult; stdcall;
function CallAsFunc(lMethodNum: Integer; var pvarRetValue: OleVariant; var paParams: PSafeArray): HResult; 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;

{ IStatusLine }
function SetStatusLine(const bstrSource: WideString): HResult; safecall;
function ResetStatusLine(): HResult; safecall;

procedure ShowErrorLog(fMessage:WideString);



end;

////////////////////////////////////////////////////////////­////////////
implementation

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetPropVal(lPropNum: Integer; var pvarPropVal: OleVariant): HResult; stdcall;
//Çäåñü 1Ñ ÷èòàåò çíà÷åíèÿ ñâîéñòâ
begin
VarClear(vk_object.g_Value);
try
GetPropVal := S_OK;
case TProperties(lPropNum) of

prop1: vk_object.prop1(m_get_value);
prop2: vk_object.prop2(m_get_value);
prop3: vk_object.prop3(m_get_value);
prop4: vk_object.prop4(m_get_value);
prop5: vk_object.prop5(m_get_value);
(*5*)
else
GetPropVal := S_FALSE;
end;
pvarPropVal := vk_object.g_Value;
except
on E: Exception do begin
ShowErrorLog('Îøèáêà ÷òåíèÿ ñâîéñòâà: '+E.Message);
GetPropVal := S_FALSE;
end;
end;

end;

////////////////////////////////////////////////////////////­////////////
//Çäåñü 1Ñ óñòàíàâëèâàåò çíà÷åíèÿ ñâîéñòâ
function AddInObject.SetPropVal(
lPropNum: Integer; //Íîìåð ñâîéñòâà
var varPropVal: OleVariant //Çíà÷åíèå, êîòîðîå 1Ñ õî÷åò óñòàíîâèòü
): HResult; stdcall;
begin
try
Result := S_OK;
vk_object.g_Value:=varPropVal;
case TProperties(lPropNum) of
prop1: vk_object.prop1(m_set_value);
prop2: vk_object.prop2(m_set_value);
prop3: vk_object.prop3(m_set_value);
prop4: vk_object.prop4(m_set_value);
prop5: vk_object.prop5(m_set_value);
(*6*)
else
Result := S_FALSE;
end;
except
on E:Exception do begin
ShowErrorLog('Îøèáêà èçìåíåíèÿ ñâîéñòâà: '+E.Message);
SetPropVal := S_FALSE;
end;
end;
end;



////////////////////////////////////////////////////////////­////////////
function AddInObject.CallAsFunc(lMethodNum: Integer; var pvarRetValue: OleVariant; var paParams: PSafeArray): HResult; stdcall;
{Çäåñü 1Ñ âûïîëíÿåò êîä âíåøíèõ ôóíêöèé}
begin
try
pvarRetValue:=0;
vk_object.g_Value:=0;
vk_object.g_Params:=paParams;
vk_object.g_Event:='';
vk_object.g_Event_Data:='';

case TMethods(lMethodNum) of
meth1: vk_object.meth1(m_execute);
meth2: vk_object.meth2(m_execute);
meth3: vk_object.meth3(m_execute);
meth4: vk_object.meth4(m_execute);
meth5: vk_object.meth5(m_execute)
(*7*)


else begin
CallAsFunc := S_FALSE;
Exit;
end;
end; //case
pvarRetValue := vk_object.g_Value;

if vk_object.g_Event<>'' then begin
iEvent.ExternalEvent(c_AddinName, vk_object.g_Event, vk_object.g_Event_Data);
end;

except
on E: Exception do begin
ShowErrorLog(E.Message);
end;
end;


CallAsFunc := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.FindProp(const bstrPropName: WideString; var plPropNum: Integer): HResult; stdcall;
var
i: Integer;
var s: String;
begin
s:= bstrPropName;
if s= vk_object.prop1(m_rus_name) then i:=Integer(prop1)
else if s= vk_object.prop1(m_eng_name) then i:=Integer(prop1)

else if s= vk_object.prop2(m_rus_name) then i:=Integer(prop2)
else if s= vk_object.prop2(m_eng_name) then i:=Integer(prop2)

else if s= vk_object.prop3(m_rus_name) then i:=Integer(prop3)
else if s= vk_object.prop3(m_eng_name) then i:=Integer(prop3)

else if s= vk_object.prop4(m_rus_name) then i:=Integer(prop4)
else if s= vk_object.prop4(m_eng_name) then i:=Integer(prop4)

else if s= vk_object.prop5(m_rus_name) then i:=Integer(prop5)
else if s= vk_object.prop5(m_eng_name) then i:=Integer(prop5)
(*8*)


else begin
plPropNum:=-1;
FindProp := S_FALSE;
Exit;
end;
plPropNum:=i;
FindProp := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.FindMethod(const bstrMethodName: WideString; var plMethodNum: Integer): HResult; stdcall;
//1Ñ ïîëó÷àåò íîìåð ìåòîäà ïî åãî èìåíè
var NewMethodName: WideString;
var i:Integer;
var s:String;
begin
NewMethodName := bstrMethodName;


s:= bstrMethodName;
if s= vk_object.meth1(m_rus_name) then i:=Integer(meth1)
else if s= vk_object.meth1(m_eng_name) then i:=Integer(meth1)

else if s= vk_object.meth2(m_rus_name) then i:=Integer(meth2)
else if s= vk_object.meth2(m_eng_name) then i:=Integer(meth2)

else if s= vk_object.meth3(m_rus_name) then i:=Integer(meth3)
else if s= vk_object.meth3(m_eng_name) then i:=Integer(meth3)

else if s= vk_object.meth4(m_rus_name) then i:=Integer(meth4)
else if s= vk_object.meth4(m_eng_name) then i:=Integer(meth4)

else if s= vk_object.meth5(m_rus_name) then i:=Integer(meth5)
else if s= vk_object.meth5(m_eng_name) then i:=Integer(meth5)
(*9*)

else begin
plMethodNum:=-1;
FindMethod := S_FALSE;
Exit;
end;

plMethodNum:=i;
FindMethod := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetNParams(lMethodNum: Integer; var plParams: Integer): HResult; stdcall;
//Çäåñü 1Ñ óçíàåò êîëè÷åñòâî ïàðàìåòðîâ ó ìåòîäîâ
begin
vk_object.g_NParams:=0;
case TMethods(lMethodNum) of
meth1: vk_object.meth1(m_n_params);
meth2: vk_object.meth2(m_n_params);
meth3: vk_object.meth3(m_n_params);
meth4: vk_object.meth4(m_n_params);
meth5: vk_object.meth5(m_n_params);
(*10*)

end;
plParams:=vk_object.g_NParams;
GetNParams := S_OK;

end;


////////////////////////////////////////////////////////////­////////////
function AddInObject.Init(pConnection: IDispatch): HResult; stdcall;
//1Ñ âûçûâàåò ýòó ôóíêöèþ ïðè èíèöèàëèçàöèè (ñòàðòå) êîìïîíåíòû
begin
i1cv7:=pConnection;

iError:=nil;
pConnection.QueryInterface(IID_IErrorLog,iError);

iStatus:=nil;
pConnection.QueryInterface(IID_IStatusLine,iStatus);

iEvent := nil;
pConnection.QueryInterface(IID_IAsyncEvent,iEvent);

iExtWindows:=nil;
pConnection.QueryInterface(IID_IExtWndsSupport,iExtWindows);

vk_object:=T_vk_object.Create();

Init := S_FALSE;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.Done: HResult; stdcall;
//1Ñ âûçûâàåò ýòó ôóíêöèþ ïðè çàâåðøåíèè ðàáîòû êîìïîíåíòû
begin
If ( iStatus <> nil ) then
iStatus._Release();

If ( iExtWindows <> nil ) then
iExtWindows._Release();

If ( iError <> nil ) then
iError._Release();

if (iEvent <> nil) then
iEvent._Release();

vk_object.Destroy();

Done := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetInfo(var pInfo: PSafeArray{(OleVariant)}): HResult; stdcall;
var varInfo : OleVariant;
var i: Integer;
begin
i:=0;
varInfo:=2000;
// varInfo := '2000';
SafeArrayPutElement(pInfo,i,varInfo);

GetInfo := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.SetStatusLine(const bstrSource: WideString): HResult; safecall;
//Ôóíêöèè äëÿ ðàáîòû ñî ñòðîêîé ñîñòîÿíèÿ
begin
SetStatusLine:=S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.ResetStatusLine(): HResult; safecall;
begin
Result := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.RegisterExtensionAs(var bstrExtensionName: WideString): HResult; stdcall;
begin
bstrExtensionName := c_AddinName;
RegisterExtensionAs := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetNProps(var plProps: Integer): HResult; stdcall;
begin
plProps := Integer(c_PropCount);
GetNProps := S_OK;
end;


////////////////////////////////////////////////////////////­////////////
function AddInObject.GetPropName(lPropNum, lPropAlias: Integer; var pbstrPropName: WideString): HResult; stdcall;
begin
pbstrPropName := '';
GetPropName := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.IsPropReadable(lPropNum: Integer; var pboolPropRead: Integer): HResult; stdcall;
begin
IsPropReadable := S_OK; //Âñå ñâîéñòâà ìîæíî ÷èòàòü
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.IsPropWritable(lPropNum: Integer; var pboolPropWrite: Integer): HResult; stdcall;
begin
IsPropWritable := S_OK; //Âñå ñâîéñòâà ìîæíî ÷èòàòü
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetNMethods(var plMethods: Integer): HResult; stdcall;
begin
plMethods := c_MethCount;
GetNMethods := S_OK;
end;


////////////////////////////////////////////////////////////­////////////
function AddInObject.GetMethodName(lMethodNum, lMethodAlias: Integer; var pbstrMethodName: WideString): HResult; stdcall;
begin
pbstrMethodName := '';
GetMethodName := S_OK;
end;


////////////////////////////////////////////////////////////­////////////
function AddInObject.GetParamDefValue(lMethodNum, lParamNum: Integer; var pvarParamDefValue: OleVariant): HResult; stdcall;
//Ïîçâîëÿåò óñòàíîâèòü çíà÷åíèÿ ïî óìîë÷àíèþ äëÿ ïàðàìåòðîâ.
begin
{ Ther is no default value for any parameter }
VarClear(pvarParamDefValue);
GetParamDefValue := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.HasRetVal(lMethodNum: Integer; var pboolRetValue: Integer): HResult; stdcall;
begin
pboolRetValue := 1; //Âñå ìåòîäû âîçâðàùàþò çíà÷åíèå
HasRetVal := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.CallAsProc(lMethodNum: Integer; var paParams: PSafeArray{(OleVariant)}): HResult; stdcall;
begin
CallAsProc := S_FALSE;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
////////////////////////////////////////////////////////////­////////////
procedure AddInObject.ShowErrorLog(fMessage:WideString);
//Ïîêàç ñîîáùåíèÿ îá îøèáêå.
var
ErrInfo: PExcepInfo;
begin
If Trim(fMessage) = '' then Exit;
New(ErrInfo);
ErrInfo^.bstrSource := c_AddinName;
ErrInfo^.bstrDescription := fMessage;
ErrInfo^.wCode:=1006;
ErrInfo^.sCode:=E_FAIL;
iError.AddError(nil, ErrInfo);
end;

type

AddInObject1 = class(TComObject, IDispatch, IInitDone, ILanguageExtender)

public
i1cv7: IDispatch;
iStatus: IStatusLine;
iExtWindows: IExtWndsSupport;
iError: IErrorLog;
iEvent : IAsyncEvent;
protected
//Ïåðåìåííàÿ îáúåêòà âíåøíåé êîìïîíåíòû
vk_object: T_vk_object;
{ IInitDone implementation }
function Init(pConnection: IDispatch): HResult; stdcall;
function Done: HResult; stdcall;
function GetInfo(var pInfo: PSafeArray): HResult; stdcall;

{ ILanguageExtender implementation }
function RegisterExtensionAs(var bstrExtensionName: WideString): HResult; stdcall;
function GetNProps(var plProps: Integer): HResult; stdcall;
function FindProp(const bstrPropName: WideString; var plPropNum: Integer): HResult; stdcall;
function GetPropName(lPropNum, lPropAlias: Integer; var pbstrPropName: WideString): HResult; stdcall;
function GetPropVal(lPropNum: Integer; var pvarPropVal: OleVariant): HResult; stdcall;
function SetPropVal(lPropNum: Integer; var varPropVal: OleVariant): HResult; stdcall;
function IsPropReadable(lPropNum: Integer; var pboolPropRead: Integer): HResult; stdcall;
function IsPropWritable(lPropNum: Integer; var pboolPropWrite: Integer): HResult; stdcall;
function GetNMethods(var plMethods: Integer): HResult; stdcall;
function FindMethod(const bstrMethodName: WideString; var plMethodNum: Integer): HResult; stdcall;
function GetMethodName(lMethodNum, lMethodAlias: Integer; var pbstrMethodName: WideString): HResult; stdcall;
function GetNParams(lMethodNum: Integer; var plParams: Integer): HResult; stdcall;
function GetParamDefValue(lMethodNum, lParamNum: Integer; var pvarParamDefValue: OleVariant): HResult; stdcall;
function HasRetVal(lMethodNum: Integer; var pboolRetValue: Integer): HResult; stdcall;
function CallAsProc(lMethodNum: Integer; var paParams: PSafeArray): HResult; stdcall;
function CallAsFunc(lMethodNum: Integer; var pvarRetValue: OleVariant; var paParams: PSafeArray): HResult; 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;

{ IStatusLine }
function SetStatusLine(const bstrSource: WideString): HResult; safecall;
function ResetStatusLine(): HResult; safecall;
procedure ShowErrorLog(fMessage:WideString);
end;

////////////////////////////////////////////////////////////­////////////


////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetPropVal(lPropNum: Integer; var pvarPropVal: OleVariant): HResult; stdcall;
//Çäåñü 1Ñ ÷èòàåò çíà÷åíèÿ ñâîéñòâ
begin
VarClear(vk_object.g_Value);
try
GetPropVal := S_OK;
case TProperties(lPropNum) of

prop1: vk_object.prop1(m_get_value);
prop2: vk_object.prop2(m_get_value);
prop3: vk_object.prop3(m_get_value);
prop4: vk_object.prop4(m_get_value);
prop5: vk_object.prop5(m_get_value);
(*5*)
else
GetPropVal := S_FALSE;
end;
pvarPropVal := vk_object.g_Value;
except
on E: Exception do begin
ShowErrorLog('Îøèáêà ÷òåíèÿ ñâîéñòâà: '+E.Message);
GetPropVal := S_FALSE;
end;
end;

end;

////////////////////////////////////////////////////////////­////////////
//Çäåñü 1Ñ óñòàíàâëèâàåò çíà÷åíèÿ ñâîéñòâ
function AddInObject1.SetPropVal(
lPropNum: Integer; //Íîìåð ñâîéñòâà
var varPropVal: OleVariant //Çíà÷åíèå, êîòîðîå 1Ñ õî÷åò óñòàíîâèòü
): HResult; stdcall;
begin
try
Result := S_OK;
vk_object.g_Value:=varPropVal;
case TProperties(lPropNum) of
prop1: vk_object.prop1(m_set_value);
prop2: vk_object.prop2(m_set_value);
prop3: vk_object.prop3(m_set_value);
prop4: vk_object.prop4(m_set_value);
prop5: vk_object.prop5(m_set_value);
(*6*)
else
Result := S_FALSE;
end;
except
on E:Exception do begin
ShowErrorLog('Îøèáêà èçìåíåíèÿ ñâîéñòâà: '+E.Message);
SetPropVal := S_FALSE;
end;
end;
end;



////////////////////////////////////////////////////////////­////////////
function AddInObject1.CallAsFunc(lMethodNum: Integer; var pvarRetValue: OleVariant; var paParams: PSafeArray): HResult; stdcall;
{Çäåñü 1Ñ âûïîëíÿåò êîä âíåøíèõ ôóíêöèé}
begin
try
pvarRetValue:=0;
vk_object.g_Value:=0;
vk_object.g_Params:=paParams;
vk_object.g_Event:='';
vk_object.g_Event_Data:='';

case TMethods(lMethodNum) of
meth1: vk_object.meth1(m_execute);
meth2: vk_object.meth2(m_execute);
meth3: vk_object.meth3(m_execute);
meth4: vk_object.meth4(m_execute);
meth5: vk_object.meth5(m_execute)
(*7*)


else begin
CallAsFunc := S_FALSE;
Exit;
end;
end; //case
pvarRetValue := vk_object.g_Value;

if vk_object.g_Event<>'' then begin
iEvent.ExternalEvent(c_AddinName, vk_object.g_Event, vk_object.g_Event_Data);
end;

except
on E: Exception do begin
ShowErrorLog(E.Message);
end;
end;


CallAsFunc := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.FindProp(const bstrPropName: WideString; var plPropNum: Integer): HResult; stdcall;
var
i: Integer;
var s: String;
begin
s:= bstrPropName;
if s= vk_object.prop1(m_rus_name) then i:=Integer(prop1)
else if s= vk_object.prop1(m_eng_name) then i:=Integer(prop1)

else if s= vk_object.prop2(m_rus_name) then i:=Integer(prop2)
else if s= vk_object.prop2(m_eng_name) then i:=Integer(prop2)

else if s= vk_object.prop3(m_rus_name) then i:=Integer(prop3)
else if s= vk_object.prop3(m_eng_name) then i:=Integer(prop3)

else if s= vk_object.prop4(m_rus_name) then i:=Integer(prop4)
else if s= vk_object.prop4(m_eng_name) then i:=Integer(prop4)

else if s= vk_object.prop5(m_rus_name) then i:=Integer(prop5)
else if s= vk_object.prop5(m_eng_name) then i:=Integer(prop5)
(*8*)


else begin
plPropNum:=-1;
FindProp := S_FALSE;
Exit;
end;
plPropNum:=i;
FindProp := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.FindMethod(const bstrMethodName: WideString; var plMethodNum: Integer): HResult; stdcall;
//1Ñ ïîëó÷àåò íîìåð ìåòîäà ïî åãî èìåíè
var NewMethodName: WideString;
var i:Integer;
var s:String;
begin
NewMethodName := bstrMethodName;
s:= bstrMethodName;
if s= vk_object.meth1(m_rus_name) then i:=Integer(meth1)
else if s= vk_object.meth1(m_eng_name) then i:=Integer(meth1)

else if s= vk_object.meth2(m_rus_name) then i:=Integer(meth2)
else if s= vk_object.meth2(m_eng_name) then i:=Integer(meth2)

else if s= vk_object.meth3(m_rus_name) then i:=Integer(meth3)
else if s= vk_object.meth3(m_eng_name) then i:=Integer(meth3)

else if s= vk_object.meth4(m_rus_name) then i:=Integer(meth4)
else if s= vk_object.meth4(m_eng_name) then i:=Integer(meth4)

else if s= vk_object.meth5(m_rus_name) then i:=Integer(meth5)
else if s= vk_object.meth5(m_eng_name) then i:=Integer(meth5)
(*9*)

else begin
plMethodNum:=-1;
FindMethod := S_FALSE;
Exit;
end;

plMethodNum:=i;
FindMethod := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetNParams(lMethodNum: Integer; var plParams: Integer): HResult; stdcall;
//Çäåñü 1Ñ óçíàåò êîëè÷åñòâî ïàðàìåòðîâ ó ìåòîäîâ
begin
vk_object.g_NParams:=0;
case TMethods(lMethodNum) of
meth1: vk_object.meth1(m_n_params);
meth2: vk_object.meth2(m_n_params);
meth3: vk_object.meth3(m_n_params);
meth4: vk_object.meth4(m_n_params);
meth5: vk_object.meth5(m_n_params);
(*10*)

end;
plParams:=vk_object.g_NParams;
GetNParams := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.Init(pConnection: IDispatch): HResult; stdcall;
//1Ñ âûçûâàåò ýòó ôóíêöèþ ïðè èíèöèàëèçàöèè (ñòàðòå) êîìïîíåíòû
begin
ShowMessage('Init1');
i1cv7:=pConnection;

iError:=nil;
pConnection.QueryInterface(IID_IErrorLog,iError);

iStatus:=nil;
pConnection.QueryInterface(IID_IStatusLine,iStatus);

iEvent := nil;
pConnection.QueryInterface(IID_IAsyncEvent,iEvent);

iExtWindows:=nil;
pConnection.QueryInterface(IID_IExtWndsSupport,iExtWindows);

vk_object:=T_vk_object.Create();

Init := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.Done: HResult; stdcall;
//1Ñ âûçûâàåò ýòó ôóíêöèþ ïðè çàâåðøåíèè ðàáîòû êîìïîíåíòû
begin
If ( iStatus <> nil ) then
iStatus._Release();

If ( iExtWindows <> nil ) then
iExtWindows._Release();

If ( iError <> nil ) then
iError._Release();

if (iEvent <> nil) then
iEvent._Release();

vk_object.Destroy();

Done := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetInfo(var pInfo: PSafeArray{(OleVariant)}): HResult; stdcall;
var varInfo : OleVariant;
var i: Integer;
begin
i:=0;
varInfo := 2000;
SafeArrayPutElement(pInfo,i,varInfo);

GetInfo := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.SetStatusLine(const bstrSource: WideString): HResult; safecall;
//Ôóíêöèè äëÿ ðàáîòû ñî ñòðîêîé ñîñòîÿíèÿ
begin
SetStatusLine:=S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.ResetStatusLine(): HResult; safecall;
begin
Result := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.RegisterExtensionAs(var bstrExtensionName: WideString): HResult; stdcall;
begin
bstrExtensionName := c_AddinName1;
RegisterExtensionAs := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetNProps(var plProps: Integer): HResult; stdcall;
begin
plProps := Integer(c_PropCount);
GetNProps := S_OK;
end;


////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetPropName(lPropNum, lPropAlias: Integer; var pbstrPropName: WideString): HResult; stdcall;
begin
pbstrPropName := '';
GetPropName := S_OK;
end;


////////////////////////////////////////////////////////////­////////////
function AddInObject1.IsPropReadable(lPropNum: Integer; var pboolPropRead: Integer): HResult; stdcall;
begin
IsPropReadable := S_OK; //Âñå ñâîéñòâà ìîæíî ÷èòàòü
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.IsPropWritable(lPropNum: Integer; var pboolPropWrite: Integer): HResult; stdcall;
begin
IsPropWritable := S_OK; //Âñå ñâîéñòâà ìîæíî ÷èòàòü
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetNMethods(var plMethods: Integer): HResult; stdcall;
begin
plMethods := c_MethCount;
GetNMethods := S_OK;
end;


////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetMethodName(lMethodNum, lMethodAlias: Integer; var pbstrMethodName: WideString): HResult; stdcall;
begin
pbstrMethodName := '';
GetMethodName := S_OK;
end;


////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetParamDefValue(lMethodNum, lParamNum: Integer; var pvarParamDefValue: OleVariant): HResult; stdcall;
//Ïîçâîëÿåò óñòàíîâèòü çíà÷åíèÿ ïî óìîë÷àíèþ äëÿ ïàðàìåòðîâ.
begin
{ Ther is no default value for any parameter }
VarClear(pvarParamDefValue);
GetParamDefValue := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.HasRetVal(lMethodNum: Integer; var pboolRetValue: Integer): HResult; stdcall;
begin
pboolRetValue := 1; //Âñå ìåòîäû âîçâðàùàþò çíà÷åíèå
HasRetVal := S_OK;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.CallAsProc(lMethodNum: Integer; var paParams: PSafeArray{(OleVariant)}): HResult; stdcall;
begin
CallAsProc := S_FALSE;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
end;

////////////////////////////////////////////////////////////­////////////
function AddInObject1.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
////////////////////////////////////////////////////////////­////////////
procedure AddInObject1.ShowErrorLog(fMessage:WideString);
//Ïîêàç ñîîáùåíèÿ îá îøèáêå.
var
ErrInfo: PExcepInfo;
begin
If Trim(fMessage) = '' then Exit;
New(ErrInfo);
ErrInfo^.bstrSource := c_AddinName1;
ErrInfo^.bstrDescription := fMessage;
ErrInfo^.wCode:=1006;
ErrInfo^.sCode:=E_FAIL;
iError.AddError(nil, ErrInfo);
end;
////////////////////////////////////////////////////////////­////////////

begin

ComServer.SetServerName('AddIn');
TComObjectFactory.Create(ComServer,AddInObject,CLSID_AddInObject,'New','V7 AddIn 2.0',ciMultiInstance,tmSingle);
TComObjectFactory.Create(ComServer,AddInObject1,CLSID_AddInObject1,'New1','V7 AddIn 2.0',ciMultiInstance,tmSingle);
end.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Строковый ресурс в библиотеки
ID100=New|New1

Я уже сказал, что зол. Поэтому те, кто будет посылать меня по ссылкам - идите лесом. Лучше не пишите!. Просто скажите, где я не прав!
По теме из базы знаний
Подписаться на ответы Инфостарт бот Сортировка: Древо развёрнутое
Свернуть все
Оставьте свое сообщение

Для получения уведомлений об ответах подключите телеграм бот:
Инфостарт бот