Вход | Регистрация

1С:Предприятие :: 1С:Предприятие 7.7 и ранее

v7: Разработка внешней компоненты 1С. Ошибка "Поле агрегатного объекта не обнаружено"

v7: Разработка внешней компоненты 1С. Ошибка "Поле агрегатного объекта не обнаружено"
Я
   lowuser
 
09.11.17 - 17:41
Нужна помощь. Делаю внешнюю компоненту для 1С 7.7, все по примеру, компонента к 1С подключается, создается объект, но при попытке обращения к методам данного объекта 1С выдает ошибку что Поле агрегатного объекта не обнаружено.
 
 
   asady
 
1 - 09.11.17 - 17:45
значит обращаешься к методу как к атрибуту
   Масянька
 
2 - 09.11.17 - 17:47
Не объявил, как глоб. переменную.
   v77
 
3 - 09.11.17 - 17:55
Значит поле агрегатного объекта не обнаружено
   lowuser
 
4 - 09.11.17 - 17:57
unit AddInObj;

interface

uses ComServ, ComObj, ActiveX, SysUtils, Windows, UnitDModule, AddInLib;

const
    CLSID_AddInObject : TGUID = '{5A3C391E-5EB3-41DE-B8C5-49EAB4F55ADA}';
const
    ComObj_Name = 'TcpSocket';
resourcestring
    strSend = 'Send,Отправить';

type
TProperties = (LastProp);
TMethods    = (methSend, LastMethod);

TAddInSocket = class (TComObject, IInitDone, IDispatch, ISpecifyPropertyPages, ILanguageExtender)
      { Attributes }

      { Interfaces }
    pErrorLog : IErrorLog;
    pEvent : IAsyncEvent;
    pProfile : IPropertyProfile;
    pStatusLine : IStatusLine;

    function LoadProperties: Boolean;
    procedure SaveProperties;
      { This function is useful in ILanguageExtender implementation }
    function TermString(strTerm: string; iAlias: Integer): string;
      {These two methods is convenient way to access function
       parameters from SAFEARRAY vector of variants }
    function GetNParam(var pArray : PSafeArray; lIndex: Integer ): OleVariant;
    procedure PutNParam(var pArray: PSafeArray; lIndex: Integer; var varPut: OleVariant);

      { Interface implementation }
      { IInitDone implementation }
    function Init(pConnection: IDispatch): HResult; stdcall;
    function Done: HResult; stdcall;
    function GetInfo(var pInfo: PSafeArray{(OleVariant)}): HResult; stdcall;
      { ISpecifyPropertyPages implementation }
    function GetPages(out Pages: TCAGUID) : 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{(OleVariant)}): HResult; stdcall;
    function CallAsFunc(lMethodNum: Integer; var pvarRetValue: OleVariant; var paParams: PSafeArray{(OleVariant)}): 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;

end;

implementation
function TAddInSocket.LoadProperties: Boolean;
begin
    LoadProperties := True;
end;

procedure TAddInSocket.SaveProperties;
begin

end;

function TAddInSocket.TermString(strTerm: string; iAlias: Integer): string;
var
     iSemicolon: Integer;
begin
    iSemicolon := Pos(',',strTerm);
    if (iAlias = 0) then
        if (iSemicolon = 0) then
            TermString := strTerm
        else
            TermString := Copy(strTerm,1,iSemicolon-1)
    else { iAlias = 1}
        if (iSemicolon = 0) then
            TermString := ''
        else
            TermString := Copy(strTerm,iSemicolon+1,Length(strTerm) - iSemicolon);
end;

function TAddInSocket.GetNParam(var pArray : PSafeArray; lIndex: Integer ): OleVariant;
var varGet : OleVariant;
begin
    SafeArrayGetElement(@pArray,lIndex,varGet);
    GetNParam := varGet;
end;

procedure TAddInSocket.PutNParam(var pArray: PSafeArray; lIndex: Integer; var varPut: OleVariant);
begin
    SafeArrayPutElement(@pArray,lIndex,varPut);
end;

{ IInitDone interface }

function TAddInSocket.Init(pConnection: IDispatch): HResult; stdcall;
var iRes : Integer;
begin
    pErrorLog := nil;
    pConnection.QueryInterface(IID_IErrorLog,pErrorLog);

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

    pProfile := nil;
    iRes := pConnection.QueryInterface(IID_IPropertyProfile,pProfile);
    if (iRes = S_OK) then
    begin
        pProfile.RegisterProfileAs(ComObj_Name + ' Profile Name');
        if (LoadProperties() <> True) then
        begin
            Init := E_FAIL;
            Exit;
        end;
    end;

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

    Init := S_OK;
end;

function TAddInSocket.Done: HResult; stdcall;
begin
    if (pErrorLog <> nil)   then pErrorLog._Release();
    if (pEvent <> nil)      then pEvent._Release();
    if (pProfile <> nil)    then pProfile._Release();
    if (pStatusLine <> nil) then pStatusLine._Release();
    Done := S_OK;
end;

function TAddInSocket.GetInfo(var pInfo: PSafeArray{(OleVariant)}): HResult; stdcall;
var  varInfo : OleVariant;
begin
    varInfo := '2000';
    PutNParam(pInfo,0,varInfo);
    GetInfo := S_OK;
end;

{ ISpecifyPropertyPages interface }

function TAddInSocket.GetPages(out Pages: TCAGUID) : HResult; stdcall;
begin
    GetPages := S_OK;
end;

{ ILanguageExtender interface }

function TAddInSocket.RegisterExtensionAs(var bstrExtensionName: WideString): HResult; stdcall;
begin
    bstrExtensionName := ComObj_Name;
    RegisterExtensionAs := S_OK;
end;

function TAddInSocket.GetNProps(var plProps: Integer): HResult; stdcall;
begin
    plProps := Integer(LastProp);
    GetNProps := S_OK;
end;

function TAddInSocket.FindProp(const bstrPropName: WideString; var plPropNum: Integer): HResult; stdcall;
begin
    plPropNum := -1;

    if (plPropNum = -1) then
    begin
        FindProp := S_FALSE;
        Exit;
    end;
    FindProp := S_OK;
end;

function TAddInSocket.GetPropName(lPropNum, lPropAlias: Integer; var pbstrPropName: WideString): HResult; stdcall;
begin
    pbstrPropName := '';
    case TProperties(lPropNum) of
       LastProp:
        else
        begin
            GetPropName := S_FALSE;
            Exit;
        end;
    end;
    GetPropName := S_OK;
end;

function TAddInSocket.GetPropVal(lPropNum: Integer; var pvarPropVal: OleVariant): HResult; stdcall;
begin
    VarClear(pvarPropVal);
    case TProperties(lPropNum) of
        LastProp:
        else
        begin
            GetPropVal := S_FALSE;
            Exit;
        end;
    end;
    GetPropVal := S_OK;
end;

function TAddInSocket.SetPropVal(lPropNum: Integer; var varPropVal: OleVariant): HResult; stdcall;
begin
    case TProperties(lPropNum) of
       LastProp:
        else
        begin
            SetPropVal := S_FALSE;
            Exit;
        end;
    end;
    SetPropVal := S_OK;
end;

function TAddInSocket.IsPropReadable(lPropNum: Integer; var pboolPropRead: Integer): HResult; stdcall;
begin
    case TProperties(lPropNum) of
        LastProp:
        else
        begin
            IsPropReadable := S_FALSE;
            Exit;
        end;
    end;
    IsPropReadable := S_OK;
end;

function TAddInSocket.IsPropWritable(lPropNum: Integer; var pboolPropWrite: Integer): HResult; stdcall;
begin
    case TProperties(lPropNum) of
        LastProp:
        else
        begin
            IsPropWritable := S_FALSE;
            Exit;
        end;
    end;
    IsPropWritable := S_OK;
end;

function TAddInSocket.GetNMethods(var plMethods: Integer): HResult; stdcall;
begin
    plMethods := Integer(LastMethod);
    GetNMethods := S_OK;
end;

function TAddInSocket.FindMethod(const bstrMethodName: WideString; var plMethodNum: Integer): HResult; stdcall;
begin
    plMethodNum := -1;
    if (bstrMethodName = TermString(strSend,0)) then plMethodNum := 0;
    if (bstrMethodName = TermString(strSend,1)) then plMethodNum := 0;
    if bstrMethodName = 'Send' then plMethodNum := 0;

    if (plMethodNum = -1) then
    begin
        FindMethod := S_FALSE;
        Exit;
    end;
    FindMethod := S_OK;
end;

function TAddInSocket.GetMethodName(lMethodNum, lMethodAlias: Integer; var pbstrMethodName: WideString): HResult; stdcall;
begin
    pbstrMethodName := '';
    case TMethods(lMethodNum) of
        methSend: pbstrMethodName := TermString(strSend, lMethodAlias);
        LastMethod:
        else
        begin
            GetMethodName := S_FALSE;
            Exit;
        end;
    end;
    GetMethodName := S_OK;
end;

function TAddInSocket.GetNParams(lMethodNum: Integer; var plParams: Integer): HResult; stdcall;
begin
    plParams := 0;

    case TMethods(lMethodNum) of
        methSend: plParams := 3;
        LastMethod:
        else
        begin
            GetNParams := S_FALSE;
            Exit;
        end;
    end;
    GetNParams := S_OK;
end;

function TAddInSocket.GetParamDefValue(lMethodNum, lParamNum: Integer; var pvarParamDefValue: OleVariant): HResult; stdcall;
begin
    VarClear(pvarParamDefValue);
    GetParamDefValue := S_OK;
end;

function TAddInSocket.HasRetVal(lMethodNum: Integer; var pboolRetValue: Integer): HResult; stdcall;
begin
    case TMethods(lMethodNum) of
        methSend: pboolRetValue := 1;
        LastMethod:
        else
        begin
            HasRetVal := S_FALSE;
            Exit;
        end;
    end;
    HasRetVal := S_OK;
end;

function TAddInSocket.CallAsProc(lMethodNum: Integer; var paParams: PSafeArray{(OleVariant)}): HResult; stdcall;
begin
    case TMethods(lMethodNum) of
        methSend:
        begin
            CallAsProc := S_FALSE;
            Exit;
        end;
        LastMethod:
        else
        begin
            CallAsProc := S_FALSE;
            Exit;
        end;
    end;
    CallAsProc := S_OK;
end;

function TAddInSocket.CallAsFunc(lMethodNum: Integer; var pvarRetValue: OleVariant; var paParams: PSafeArray{(OleVariant)}): HResult; stdcall;
var
    host,port,mess: ansistring;
begin
    case TMethods(lMethodNum) of
        methSend:
        begin
            host:= GetNParam(paParams,0);
            port:= GetNParam(paParams,1);
            mess:= GetNParam(paParams,2);
            pvarRetValue:= DModule.Send(host, port, mess);
            Result := S_OK;
            Exit;
        end;
        LastMethod:
        else
        begin
            Result := S_FALSE;
            Exit;
        end;
    end;
    CallAsFunc := S_FALSE;
end;

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

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

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

function TAddInSocket.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

initialization

ComServer.SetServerName('AddIn');
TComObjectFactory.Create(ComServer, TAddInSocket, CLSID_AddInObject,
                 ComObj_Name, 'V7 AddIn 2.0', ciSingleInstance);

end.
   v77
 
5 - 09.11.17 - 18:02
возьми да в отладчике посмотри
   v77
 
6 - 09.11.17 - 18:06
TermString() какой то выдумал. Будь проще. 
Может большие и маленькие буквы?
   lowuser
 
7 - 09.11.17 - 18:17
Точно не из-за Больших и маленьких - пробовал по всякому...
   lowuser
 
8 - 10.11.17 - 13:53
Идей больше ни у кого нет? (((
   v77
 
9 - 10.11.17 - 14:02
(8) ты в отладчике смотрел? вот посмотри.
   trdm
 
10 - 10.11.17 - 14:10
(0) Фигани на гитхаб. А то текст модулей нечитаем вобще
 
 Рекламное место пустует

Список тем форума
Рекламное место пустует  Рекламное место пустует
2 + 2 = 3.9999999999999999999999999999999...
ВНИМАНИЕ! Если вы потеряли окно ввода сообщения, нажмите Ctrl-F5 или Ctrl-R или кнопку "Обновить" в браузере.
Тема не обновлялась длительное время, и была помечена как архивная. Добавление сообщений невозможно.
Но вы можете создать новую ветку и вам обязательно ответят!
Каждый час на Волшебном форуме бывает более 2000 человек.
Рекламное место пустует