7.7 В 1С 7.7 не срабатывает ОбработкаВнешнегоСобытия

Тема в разделе "Конфигурирование на платформе "1С:Предприятие 7.7"", создана пользователем krasdok, 6 сен 2012.

  1. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    Здравствуйте!
    Написал свою DLL, подключил (все хорошо, работает)...
    Написал в этом же модуле процедуру:

    Процедура ОбработкаВнешнегоСобытия(Источник, Событие, Данные)
    Если Источник="vk" Тогда
    Сообщить(Источник);
    КонецЕсли;
    КонецПроцедуры
    Подскажите почему???
    Очень жду ответа!!!
  2. Бухгалтерский угодник
    Offline

    Бухгалтерский угодник Администраторы Команда форума Администратор

    Регистрация:
    29 дек 2008
    Сообщения:
    21.520
    Симпатии:
    407
    Баллы:
    104
    Надо смотреть как вы генерируете ваше внешнее событие в библе
  3. SerzhM
    Offline

    SerzhM Опытный в 1С

    Регистрация:
    26 окт 2009
    Сообщения:
    511
    Симпатии:
    3
    Баллы:
    29
    Сначала уберите
    Если Источник="vk" Тогда
    КонецЕсли;
    Оставьте только сообщить(источник)
  4. Бухгалтерский угодник
    Offline

    Бухгалтерский угодник Администраторы Команда форума Администратор

    Регистрация:
    29 дек 2008
    Сообщения:
    21.520
    Симпатии:
    407
    Баллы:
    104
    Не уверен что вообще что-то происходит)))))))
  5. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    Пробовал просто Сообщить(Источник). Все равно нет сообщения. А Dll работает так как и задумывалась
  6. Бухгалтерский угодник
    Offline

    Бухгалтерский угодник Администраторы Команда форума Администратор

    Регистрация:
    29 дек 2008
    Сообщения:
    21.520
    Симпатии:
    407
    Баллы:
    104
    значит не так раз не происходит генерация события. Поэтому и предложил показать
  7. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    Что показывать??? Я только этому учусь...Брал с шаблона
    Свойства:function T_vk_object.prop1(mode: TMode): String;
    begin
    case mode of
    m_rus_name: Result:='Пиктограмма';
    m_eng_name: Result:='IconType';
    m_get_value: g_Value:=g_IconType;
    m_set_value: g_IconType:=g_Value;
    end;
    end;
    Метод:

    /////////////////////////////////////////////////////////////////////
    function T_vk_object.meth1(mode: TMode): String;
    var s: String;
    var ms: Integer;
    begin
    case mode of
    m_rus_name: Result:='ВсплывающаяПодсказка';
    m_eng_name: Result:='BalloonTooltip';
    m_n_params: g_NParams:=2; //Количество параметров функции
    m_execute: begin
    //Извлекаем параметры функции, переданные из 1С
    s:=GetParamAsString(0);//сообщение
    ms:=GetParamAsInteger(1);//задержка в мс
    //Показываем сообщение в трее
    sleep_icon(s, ms);
    end;
    end;//case
    end;
  8. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    И кто что скажет???
  9. Бухгалтерский угодник
    Offline

    Бухгалтерский угодник Администраторы Команда форума Администратор

    Регистрация:
    29 дек 2008
    Сообщения:
    21.520
    Симпатии:
    407
    Баллы:
    104
    Хм... А вам обязаны?
    Где в вашем коде событие?
    Гляньте здесь http://oksla.narod.r...m#_Toc502332920 довольно подробно все описано
  10. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    Я же и прошу помощи. Мож кусочек кода...
  11. Бухгалтерский угодник
    Offline

    Бухгалтерский угодник Администраторы Команда форума Администратор

    Регистрация:
    29 дек 2008
    Сообщения:
    21.520
    Симпатии:
    407
    Баллы:
    104
    Так и выложите не кусок а весь текст
  12. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    Вот MyVK:
    PHP:
    library MyVK;
    uses
    ComServ
    ,
    Windows,
    AddInLib in 'AddInLib.pas',
    AddInObj in 'AddInObj.pas',
    vk_object in 'vk_object.pas';
    {
    $E dll}
    exports
    DllGetClassObject
    ,
    DllCanUnloadNow,
    DllRegisterServer,
    DllUnregisterServer;
    {
    $R *.RES}
    begin
    end
    .


    Вот AddInLib

    PHP:
    unit AddInLib;
    V7 AddIn 2.0 Type Library }
    Version 2.0 }
    interface
    uses
    Windows
    ActiveX;
    const
    IID_IInitDone TIID '{AB634001-F13D-11D0-A459-004095E1DAEA}';
    IID_ILanguageExtender TIID '{AB634003-F13D-11D0-A459-004095E1DAEA}';
    IID_IStatusLine TIID '{AB634005-F13D-11D0-A459-004095E1DAEA}';
    IID_IAsyncEvent TIID '{AB634004-F13D-11D0-A459-004095E1DAEA}';
    IID_IExtWndsSupportTGUID '{EFE19EA0-09E4-11D2-A601-008048DA00DE}';
    IID_IErrorLog TIID '{3127CA40-446E-11CE-8135-00AA004BB851}';
    type
    Forward declarationsInterfaces }
    IInitDone = interface;
    ILanguageExtender = interface;
    RECT packed record
    left
    Integer;
    topInteger;
    rightInteger;
    bottomInteger;
    end;
    IInitDone Interface }
    IInitDone = interface(IUnknown)
    [
    '{AB634001-F13D-11D0-A459-004095E1DAEA}']
    function 
    Init(pConnectionIDispatch): HResultstdcall;
    function 
    DoneHResultstdcall;
    function 
    GetInfo(var pInfoPSafeArray{(OleVariant)}): HResultstdcall;
    end;
    ILanguageExtender Interface }
    ILanguageExtender = interface(IUnknown)
    [
    '{AB634003-F13D-11D0-A459-004095E1DAEA}']
    function 
    RegisterExtensionAs(var bstrExtensionNameWideString): HResultstdcall;
    function 
    GetNProps(var plPropsInteger): HResultstdcall;
    function 
    FindProp(const bstrPropNameWideString; var plPropNumInteger): HResultstdcall;
    function 
    GetPropName(lPropNumlPropAliasInteger; var pbstrPropNameWideString): HResultstdcall;
    function 
    GetPropVal(lPropNumInteger; var pvarPropValOleVariant): HResultstdcall;
    function 
    SetPropVal(lPropNumInteger; var varPropValOleVariant): HResultstdcall;
    function 
    IsPropReadable(lPropNumInteger; var pboolPropReadInteger): HResultstdcall;
    function 
    IsPropWritable(lPropNumInteger; var pboolPropWriteInteger): HResultstdcall;
    function 
    GetNMethods(var plMethodsInteger): HResultstdcall;
    function 
    FindMethod(const bstrMethodNameWideString; var plMethodNumInteger): HResultstdcall;
    function 
    GetMethodName(lMethodNumlMethodAliasInteger; var pbstrMethodNameWideString): HResultstdcall;
    function 
    GetNParams(lMethodNumInteger; var plParamsInteger): HResultstdcall;
    function 
    GetParamDefValue(lMethodNumlParamNumInteger; var pvarParamDefValueOleVariant): HResultstdcall;
    function 
    HasRetVal(lMethodNumInteger; var pboolRetValueInteger): HResultstdcall;
    function 
    CallAsProc(lMethodNumInteger; var paParamsPSafeArray): HResultstdcall;
    function 
    CallAsFunc(lMethodNumInteger; var pvarRetValueOleVariant; var paParamsPSafeArray): HResultstdcall;
    end;
    IStatusLine Interface }
    IStatusLine = interface(IUnknown)
    [
    '{AB634005-F13D-11D0-A459-004095E1DAEA}']
    function 
    SetStatusLine(const bstrSourceWideString): HResultsafecall;
    function 
    ResetStatusLine(): HResultsafecall;
    end;
    IAsyncEvent Interface }
    IAsyncEvent = interface(IUnknown)
    [
    '{AB634004-F13D-11D0-A459-004095E1DAEA}']
    procedure SetEventBufferDepth(lDepthInteger); safecall;
    procedure GetEventBufferDepth(var plDepthInteger); safecall;
    procedure ExternalEvent(const bstrSourcebstrMessagebstrDataWideString); safecall;
    procedure CleanBuffersafecall;
    end;
    IExtWndsSupport Interface }
    IExtWndsSupport = interface(IUnknown)
    [
    '{EFE19EA0-09E4-11D2-A601-008048DA00DE}']
    function 
    GetAppMainFrame(var hwndHWND): HResultstdcall;
    function 
    GetAppMDIFrame(var hwndHWND): HResultstdcall;
    function 
    CreateAddInWindow(const bstrProgIDWideString; const bstrWindowNameWideString;
    dwStylesIntegerdwExStylesInteger; var rctlRECT;
    FlagsInteger; var pHwndHWND; var pDispIDispatch): HResultstdcall;
    end;
    implementation
    initialization
    end
    .
    Вот AddInObj

    PHP:
    unit AddInObj;
    interface
    uses  Какие библиотеки используем }
    ComServComObjActiveXSysUtilsWindowsAddInLibvk_object;
    (*
    1*)
    const 
    c_AddinName 'MyVK'//Имя внешней компоненты
    ////////////////////////////////////////////////////////////////////////
    //Количество свойств
    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 '{6FA3A0F7-1971-4025-A4BE-7E5CCE220AA6}';
    ////////////////////////////////////////////////////////////////////////
    type
    AddInObject 
    = class(TComObjectIDispatchIInitDoneILanguageExtender)
    public
    i1cv7IDispatch;
    iStatusIStatusLine;
    iExtWindowsIExtWndsSupport;
    iErrorIErrorLog;
    iEvent IAsyncEvent;
    protected
    //Переменная объекта внешней компоненты
    vk_objectT_vk_object;
    IInitDone implementation }
    function 
    Init(pConnectionIDispatch): HResultstdcall;
    function 
    DoneHResultstdcall;
    function 
    GetInfo(var pInfoPSafeArray): HResultstdcall;
    ILanguageExtender implementation }
    function 
    RegisterExtensionAs(var bstrExtensionNameWideString): HResultstdcall;
    function 
    GetNProps(var plPropsInteger): HResultstdcall;
    function 
    FindProp(const bstrPropNameWideString; var plPropNumInteger): HResultstdcall;
    function 
    GetPropName(lPropNumlPropAliasInteger; var pbstrPropNameWideString): HResultstdcall;
    function 
    GetPropVal(lPropNumInteger; var pvarPropValOleVariant): HResultstdcall;
    function 
    SetPropVal(lPropNumInteger; var varPropValOleVariant): HResultstdcall;
    function 
    IsPropReadable(lPropNumInteger; var pboolPropReadInteger): HResultstdcall;
    function 
    IsPropWritable(lPropNumInteger; var pboolPropWriteInteger): HResultstdcall;
    function 
    GetNMethods(var plMethodsInteger): HResultstdcall;
    function 
    FindMethod(const bstrMethodNameWideString; var plMethodNumInteger): HResultstdcall;
    function 
    GetMethodName(lMethodNumlMethodAliasInteger; var pbstrMethodNameWideString): HResultstdcall;
    function 
    GetNParams(lMethodNumInteger; var plParamsInteger): HResultstdcall;
    function 
    GetParamDefValue(lMethodNumlParamNumInteger; var pvarParamDefValueOleVariant): HResultstdcall;
    function 
    HasRetVal(lMethodNumInteger; var pboolRetValueInteger): HResultstdcall;
    function 
    CallAsProc(lMethodNumInteger; var paParamsPSafeArray): HResultstdcall;
    function 
    CallAsFunc(lMethodNumInteger; var pvarRetValueOleVariant; var paParamsPSafeArray): HResultstdcall;
    IDispatch }
    function 
    GetIDsOfNames(const IIDTGUIDNamesPointer;
    NameCountLocaleIDIntegerDispIDsPointer): HResultvirtualstdcall;
    function 
    GetTypeInfo(IndexLocaleIDIntegerout TypeInfo): HResultvirtualstdcall;
    function 
    GetTypeInfoCount(out CountInteger): HResultvirtualstdcall;
    function 
    Invoke(DispIDInteger; const IIDTGUIDLocaleIDInteger;
    FlagsWord; var ParamsVarResultExcepInfoArgErrPointer): HResultvirtualstdcall;
    IStatusLine }
    function 
    SetStatusLine(const bstrSourceWideString): HResultsafecall;
    function 
    ResetStatusLine(): HResultsafecall;
    procedure ShowErrorLog(fMessage:WideString);
    end;
    ////////////////////////////////////////////////////////////////////////
    implementation
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetPropVal(lPropNumInteger; var pvarPropValOleVariant): HResultstdcall;
    //Здесь 1С читает значения свойств
    begin
    VarClear
    (vk_object.g_Value);
    try
    GetPropVal := S_OK;
    case 
    TProperties(lPropNumof
    prop1
    vk_object.prop1(m_get_value);
    prop2vk_object.prop2(m_get_value);
    prop3vk_object.prop3(m_get_value);
    prop4vk_object.prop4(m_get_value);
    prop5vk_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(
    lPropNumInteger//Номер свойства
    var varPropVal:  OleVariant //Значение, которое 1С хочет установить
    ): HResultstdcall;
    begin
    try
    Result := S_OK;
    vk_object.g_Value:=varPropVal;
    case 
    TProperties(lPropNumof
    prop1
    vk_object.prop1(m_set_value);
    prop2vk_object.prop2(m_set_value);
    prop3vk_object.prop3(m_set_value);
    prop4vk_object.prop4(m_set_value);
    prop5vk_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(lMethodNumInteger; var pvarRetValueOleVariant; var paParamsPSafeArray): HResultstdcall;
    {
    Здесь 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(lMethodNumof
    meth1
    vk_object.meth1(m_execute);
    meth2vk_object.meth2(m_execute);
    meth3vk_object.meth3(m_execute);
    meth4vk_object.meth4(m_execute);
    meth5vk_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_AddinNamevk_object.g_Eventvk_object.g_Event_Data);
    end;
    except
    on E
    Exception do begin
    ShowErrorLog
    (E.Message);
    end;
    end;
    CallAsFunc := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.FindProp(const bstrPropNameWideString; var plPropNumInteger): HResultstdcall;
    var
    iInteger;
    var 
    sString;
    begin
    s
    := bstrPropName;
    if 
    svk_object.prop1(m_rus_namethen i:=Integer(prop1)
    else if 
    svk_object.prop1(m_eng_namethen i:=Integer(prop1)
    else if 
    svk_object.prop2(m_rus_namethen i:=Integer(prop2)
    else if 
    svk_object.prop2(m_eng_namethen i:=Integer(prop2)
    else if 
    svk_object.prop3(m_rus_namethen i:=Integer(prop3)
    else if 
    svk_object.prop3(m_eng_namethen i:=Integer(prop3)
    else if 
    svk_object.prop4(m_rus_namethen i:=Integer(prop4)
    else if 
    svk_object.prop4(m_eng_namethen i:=Integer(prop4)
    else if 
    svk_object.prop5(m_rus_namethen i:=Integer(prop5)
    else if 
    svk_object.prop5(m_eng_namethen i:=Integer(prop5)
    (*
    8*)
    else 
    begin
    plPropNum
    :=-1;
    FindProp := S_FALSE;
    Exit;
    end;
    plPropNum:=i;
    FindProp := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.FindMethod(const bstrMethodNameWideString; var plMethodNumInteger): HResultstdcall;
    //1С получает номер метода по его имени
    var NewMethodNameWideString;
    var 
    i:Integer;
    var 
    s:String;
    begin
    NewMethodName 
    := bstrMethodName;
    s:= bstrMethodName;
    if 
    svk_object.meth1(m_rus_namethen i:=Integer(meth1)
    else if 
    svk_object.meth1(m_eng_namethen i:=Integer(meth1)
    else if 
    svk_object.meth2(m_rus_namethen i:=Integer(meth2)
    else if 
    svk_object.meth2(m_eng_namethen i:=Integer(meth2)
    else if 
    svk_object.meth3(m_rus_namethen i:=Integer(meth3)
    else if 
    svk_object.meth3(m_eng_namethen i:=Integer(meth3)
    else if 
    svk_object.meth4(m_rus_namethen i:=Integer(meth4)
    else if 
    svk_object.meth4(m_eng_namethen i:=Integer(meth4)
    else if 
    svk_object.meth5(m_rus_namethen i:=Integer(meth5)
    else if 
    svk_object.meth5(m_eng_namethen i:=Integer(meth5)
    (*
    9*)
    else 
    begin
    plMethodNum
    :=-1;
    FindMethod := S_FALSE;
    Exit;
    end;
    plMethodNum:=i;
    FindMethod := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetNParams(lMethodNumInteger; var plParamsInteger): HResultstdcall;
    //Здесь 1С узнает количество параметров у методов
    begin
    vk_object
    .g_NParams:=0;
    case 
    TMethods(lMethodNumof
    meth1
    vk_object.meth1(m_n_params);
    meth2vk_object.meth2(m_n_params);
    meth3vk_object.meth3(m_n_params);
    meth4vk_object.meth4(m_n_params);
    meth5vk_object.meth5(m_n_params);
    (*
    10*)
    end;
    plParams:=vk_object.g_NParams;
    GetNParams := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.Init(pConnectionIDispatch): HResultstdcall;
    //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_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.DoneHResultstdcall;
    //1С вызывает эту функцию при завершении работы компоненты
    begin
    If ( iStatus <> nil then
    iStatus
    ._Release();
    If ( 
    iExtWindows <> nil then
    iExtWindows
    ._Release();
    If ( 
    iError <> nil then
    iError
    ._Release();
    if (
    iEvent <> nilthen
    iEvent
    ._Release();
    vk_object.Destroy();
    Done := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetInfo(var pInfoPSafeArray{(OleVariant)}): HResultstdcall;
    var  
    varInfo OleVariant;
    var 
    iInteger;
    begin
    varInfo 
    := '2000';
    SafeArrayPutElement(pInfo,i,varInfo);
    GetInfo := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.SetStatusLine(const bstrSourceWideString): HResultsafecall;
    //Функции для работы со строкой состояния
    begin
    SetStatusLine
    :=S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.ResetStatusLine(): HResultsafecall;
    begin
    Result 
    := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.RegisterExtensionAs(var bstrExtensionNameWideString): HResultstdcall;
    begin
    bstrExtensionName 
    := c_AddinName;
    RegisterExtensionAs := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetNProps(var plPropsInteger): HResultstdcall;
    begin
    plProps 
    := Integer(c_PropCount);
    GetNProps := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetPropName(lPropNumlPropAliasInteger; var pbstrPropNameWideString): HResultstdcall;
    begin
    pbstrPropName 
    := '';
    GetPropName := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.IsPropReadable(lPropNumInteger; var pboolPropReadInteger): HResultstdcall;
    begin
    IsPropReadable 
    := S_OK//Все свойства можно читать
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.IsPropWritable(lPropNumInteger; var pboolPropWriteInteger): HResultstdcall;
    begin
    IsPropWritable 
    := S_OK//Все свойства можно читать
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetNMethods(var plMethodsInteger): HResultstdcall;
    begin
    plMethods 
    := c_MethCount;
    GetNMethods := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetMethodName(lMethodNumlMethodAliasInteger; var pbstrMethodNameWideString): HResultstdcall;
    begin
    pbstrMethodName 
    := '';
    GetMethodName := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetParamDefValue(lMethodNumlParamNumInteger; var pvarParamDefValueOleVariant): HResultstdcall;
    //Позволяет установить значения по умолчанию для параметров.
    begin
    Ther is no default value for any parameter }
    VarClear(pvarParamDefValue);
    GetParamDefValue := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.HasRetVal(lMethodNumInteger; var pboolRetValueInteger): HResultstdcall;
    begin
    pboolRetValue 
    := 1//Все методы возвращают значение
    HasRetVal := S_OK;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.CallAsProc(lMethodNumInteger; var paParamsPSafeArray{(OleVariant)}): HResultstdcall;
    begin
    CallAsProc 
    := S_FALSE;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetIDsOfNames(const IIDTGUIDNamesPointer;
    NameCountLocaleIDIntegerDispIDsPointer): HResult;
    begin
    Result 
    := E_NOTIMPL;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetTypeInfo(IndexLocaleIDInteger;
    out TypeInfo): HResult;
    begin
    Result 
    := E_NOTIMPL;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.GetTypeInfoCount(out CountInteger): HResult;
    begin
    Result 
    := E_NOTIMPL;
    end;
    ////////////////////////////////////////////////////////////////////////
    function AddInObject.Invoke(DispIDInteger; const IIDTGUIDLocaleIDInteger;
    FlagsWord; var ParamsVarResultExcepInfoArgErrPointer): HResult;
    begin
    Result 
    := E_NOTIMPL;
    end;
    ////////////////////////////////////////////////////////////////////////
    procedure AddInObject.ShowErrorLog(fMessage:WideString);
    //Показ сообщения об ошибке.
    var
    ErrInfoPExcepInfo;
    begin
    If Trim(fMessage) = '' then Exit;
    New(
    ErrInfo);
    ErrInfo^.bstrSource := c_AddinName;
    ErrInfo^.bstrDescription := fMessage;
    ErrInfo^.wCode:=1006;
    ErrInfo^.sCode:=E_FAIL;
    iError.AddError(nilErrInfo);
    end;
    ////////////////////////////////////////////////////////////////////////
    begin
    ComServer
    .SetServerName('AddIn');
    TComObjectFactory.Create(ComServer,AddInObject,CLSID_AddInObject,
    c_AddinName,'V7 AddIn 2.0',ciMultiInstance);
    end.
    Вот vk_object
    PHP:
    unit vk_object;
    interface
    uses WindowsActiveXSysUtilsuBalloon;
    type TMode = (
    m_rus_name//Русское имя (метода или свойства)
    m_eng_name//Англ. имя (метода или свойства)
    m_get_value//1С читает значение свойства
    m_set_value//1С изменяет значение свойства
    m_n_params//1С получает число параметров метода (функции)
    m_execute //Выполнение метода (Функции)
    );
    type T_vk_object = class(TObject)
    public
    g_ValueOleVariant//Значение свойства или возвращаемое значение функции
    g_NParamsInteger//Количество параметров метода (функции)
    g_ParamsPSafeArray//Массив с параметрами функции
    g_Eventg_Event_DataString//Генерация события
    function prop1(modeTMode): String;
    function 
    prop2(modeTMode): String;
    function 
    prop3(modeTMode): String;
    function 
    prop4(modeTMode): String;
    function 
    prop5(modeTMode): String;
    (*
    11*)
    function 
    meth1(modeTMode): String;
    function 
    meth2(modeTMode): String;
    function 
    meth3(modeTMode): String;
    function 
    meth4(modeTMode): String;
    function 
    meth5(modeTMode): String;
    (*
    12*)
    Constructor Create;
    Destructor DestroyOverride;
    protected
    g_IconTypeInteger;
    g_TitleString;
    g_PortiInteger;
    procedure sleep_icon(msgStringmsInteger);
    function 
    GetNParam(lIndexInteger ): OleVariant;
    procedure PutNParam(lIndexInteger; var varPutOleVariant);
    function 
    GetParamAsString(lIndexInteger ): String;
    function 
    GetParamAsInteger(lIndexInteger ): Integer;
    end;
    implementation
    //////////////////////////////////////////////////////////
    //Эта процедура реализует полезную функциональность внешней компоненты.
    //А именно, показывает всплывающее сообщение в трее.
    //msg - сообщение, которое нужно показать.
    //ms - пауза в миллисекундах (значение 1000 составляет 1 секунду), в течение которых надо показывать сообщение
    //В глобальных переменных g_Title установите заголовок сообщения, в g_IconType - тип пиктограммы
    //Возможные типы пиктограммы - NIF_INFO=16, NIIF_NONE=0, NIIF_INFO=1, NIIF_WARNING=2, NIIF_ERROR=3
    procedure T_vk_object.sleep_icon(msgStringmsInteger);
    var
    IconHICON;
    WndHWND;
    begin
    Wnd
    :=GetForegroundWindow();
    Icon := LoadIcon(0IDI_APPLICATION);
    DZAddTrayIcon(Wnd1Icong_Title);
    DZBalloonTrayIcon(Wnd110msgg_TitleTBalloonIconType(g_IconType));
    Sleep(ms);
    DZRemoveTrayIcon(Wnd1);
    end;
    //////////////////////////////////////////////////////////////
    //Конструктор класса
    Constructor T_vk_object.Create;
    begin
    inherited Create
    ;
    g_Value:='';
    g_NParams:=0;
    g_Params:=nil;
    g_Event:='';
    g_Event_Data:='';
    end;
    //////////////////////////////////////////////////////////////
    //Деструктор класса
    destructor T_vk_object.Destroy;
    begin
    inherited Destroy
    ;
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.prop1(modeTMode): String;
    begin
    case mode of
    m_rus_name
    Result:='Пиктограмма';
    m_eng_nameResult:='IconType';
    m_get_valueg_Value:=g_IconType;
    m_set_valueg_IconType:=g_Value;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.prop2(modeTMode): String;
    begin
    case mode of
    m_rus_name
    Result:='Заголовок';
    m_eng_nameResult:='Title';
    m_get_valueg_Value:=g_Title;
    m_set_valueg_Title:=g_Value;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.prop3(modeTMode): String;
    begin
    case mode of
    m_rus_name
    Result:='Порт';
    m_eng_nameResult:='Porti';
    m_get_valueg_Value:=g_Porti;
    m_set_valueg_Porti:=g_Value;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.prop4(modeTMode): String;
    begin
    case mode of
    m_rus_name
    Result:='';
    m_eng_nameResult:='';
    m_get_valueg_Value:='';
    m_set_value: ;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.prop5(modeTMode): String;
    begin
    case mode of
    m_rus_name
    Result:='';
    m_eng_nameResult:='';
    m_get_valueg_Value:='';
    m_set_value: ;
    end;//case
    end;
    (*
    13*)
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.meth1(modeTMode): String;
    var 
    sString;
    var 
    msInteger;
    begin
    case mode of
    m_rus_name
    Result:='ВсплывающаяПодсказка';
    m_eng_nameResult:='BalloonTooltip';
    m_n_paramsg_NParams:=2//Количество параметров функции
    m_executebegin
    //Извлекаем параметры функции, переданные из 1С
    s:=GetParamAsString(0);//сообщение
    ms:=GetParamAsInteger(1);//задержка в мс
    //Показываем сообщение в трее
    sleep_icon(sms);
    end;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.meth2(modeTMode): String;
    var 
    sString;
    begin
    case mode of
    m_rus_name
    Result:='Предупреждение';
    m_eng_nameResult:='MessageBox';
    m_n_paramsg_NParams:=1//Количество параметров функции
    m_executebegin
    s
    :=GetParamAsString(0);//сообщение
    g_Value:=MessageBox(0pchar(s), pchar(g_Title), g_IconType);
    end;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.meth3(modeTMode): String;
    var 
    tInteger;
    begin
    case mode of
    m_rus_name
    Result:='Сигнал';
    m_eng_nameResult:='MessageBeep';
    m_n_paramsg_NParams:=1//Количество параметров функции
    m_executebegin
    t
    :=GetParamAsInteger(0);//тип звукового сигнала
    if t=-1 then
    MessageBeep
    ($FFFFFFFF)
    else
    MessageBeep(t);
    end;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.meth4(modeTMode): String;
    var 
    pInteger;
    var 
    mcInteger;
    begin
    case mode of
    m_rus_name
    Result:='Показатьпорт';
    m_eng_nameResult:='Wrport';
    m_n_paramsg_NParams:=1//Количество параметров функции
    m_executebegin
    mc
    :=3000;
    p:=GetParamAsInteger(0);
    if 
    p=1 then
    MessageBeep
    ($FFFFFFFF)
    else
    MessageBeep(p);
    g_Value:=MessageBox(0pchar('GGGG'), pchar(g_Title)+g_Portig_IconType);
    sleep_icon('dkdkdkd'mc);
    end;
    end;//case
    end;
    /////////////////////////////////////////////////////////////////////
    function T_vk_object.meth5(modeTMode): String;
    begin
    case mode of
    m_rus_name
    Result:='';
    m_eng_nameResult:='';
    m_n_paramsg_NParams:=0//Количество параметров функции
    m_execute: ;
    end;//case
    end;
    (*
    14*)
    ////////////////////////////////////////////////////////////////////////
    //Функция извлекает параметр из массива g_Params по его индексу
    function T_vk_object.GetNParam(lIndexInteger ): OleVariant;
    var
    varGet OleVariant;
    begin
    SafeArrayGetElement
    (g_Params,lIndex,varGet);
    GetNParam := varGet;
    end;
    ////////////////////////////////////////////////////////////////////////
    //Функция извлекает параметр из массива g_Params по его индексу.
    //Функция предполагает, что тип значения - строка
    function T_vk_object.GetParamAsString(lIndexInteger ): String;
    var
    varGet OleVariant;
    begin
    SafeArrayGetElement
    (g_Params,lIndex,varGet);
    try
    Result := varGet;
    except
    Raise Exception
    .Create('Параметр номер '+IntToStr(lIndex+1)+' не может быть преобразован в строку.');
    end;
    end;
    ////////////////////////////////////////////////////////////////////////
    //Функция извлекает параметр из массива g_Params по его индексу.
    //Функция предполагает, что тип значения - целое число
    function T_vk_object.GetParamAsInteger(lIndexInteger ): Integer;
    var
    varGet OleVariant;
    begin
    SafeArrayGetElement
    (g_Params,lIndex,varGet);
    try
    Result := varGet;
    except
    Raise Exception
    .Create('Параметр номер '+IntToStr(lIndex+1)+' не может быть преобразован в целое число.');
    end;
    end;
    ////////////////////////////////////////////////////////////////////////
    //Функция помещает значение в массив g_Params по указанному индексу
    procedure T_vk_object.PutNParam(lIndexInteger; var varPutOleVariant);
    begin
    SafeArrayPutElement
    (g_Params,lIndex,varPut);
    end;

    end.

    И вот uBalloon

    PHP:
    unit uBalloon;
    (*
    Образцы кода взяты из
    Delphi Russian Knowledge Base
    from Vit
    Version 2.2
    *)
    interface
    uses  Какие библиотеки используем }
    WindowsShellAPISysUtils;
    type
    TBalloonTimeout 
    10..30{seconds};
    TBalloonIconType = (bitNone,    // нет иконки
    bitInfo,    // информационная иконка (синяя)
    bitWarning// иконка восклицания (жёлтая)
    bitError);  // иконка ошибки (краснаа)
    function DZAddTrayIcon(const WindowHWND; const IconIDByte; const IconHICON; const HintString ''): Boolean;
    function 
    DZRemoveTrayIcon(const WindowHWND; const IconIDByte): Boolean;
    function 
    DZBalloonTrayIcon(const WindowHWND; const IconIDByte; const TimeoutTBalloonTimeout; const BalloonTextBalloonTitleString; const BalloonIconTypeTBalloonIconType): Boolean;
    implementation
    const
    NIF_INFO      =        $00000010;
    NIIF_NONE     =        $00000000;
    NIIF_INFO     =        $00000001;
    NIIF_WARNING  =       $00000002;
    NIIF_ERROR    =        $00000003;
    type
    NotifyIconData_50 
    record // определённая в shellapi.h
    cbSizeDWORD;
    WndHWND;
    uIDUINT;
    uFlagsUINT;
    uCallbackMessageUINT;
    hIconHICON;
    szTip: array[0..MAXCHARof AnsiChar;
    dwStateDWORD;
    dwStateMaskDWORD;
    szInfo: array[0..MAXBYTEof AnsiChar;
    uTimeoutUINT// union with uVersion: UINT;
    szInfoTitle: array[0..63of AnsiChar;
    dwInfoFlagsDWORD;
    end{record};
    ///////////////////////////////////////////////////////////////////////
    {добавление иконки }
    //Взято с Исходников.ru [url="http://www.sources.ru"]http://www.sources.ru[/url]
    function DZAddTrayIcon(const WindowHWND; const IconIDByte; const IconHICON; const HintString ''): Boolean;
    var
    NID NotifyIconData;
    begin
    FillChar
    (NIDSizeOf(NotifyIconData), 0);
    with NID do begin
    cbSize 
    := SizeOf(NotifyIconData);
    Wnd := Window;
    uID := IconID;
    if 
    Hint '' then begin
    uFlags 
    := NIF_ICON;
    end{if} else begin
    uFlags 
    := NIF_ICON or NIF_TIP;
    StrPCopy(szTipHint);
    end{else};
    hIcon := Icon;
    end{with};
    Result := Shell_NotifyIcon(NIM_ADD, @NID);
    end;
    ///////////////////////////////////////////////////////////////////////
    {удаляет иконку}
    //Взято с Исходников.ru [url="http://www.sources.ru"]http://www.sources.ru[/url]
    function DZRemoveTrayIcon(const WindowHWND; const IconIDByte): Boolean;
    var
    NID NotifyIconData;
    begin
    FillChar
    (NIDSizeOf(NotifyIconData), 0);
    with NID do begin
    cbSize 
    := SizeOf(NotifyIconData);
    Wnd := Window;
    uID := IconID;
    end{with};
    Result := Shell_NotifyIcon(NIM_DELETE, @NID);
    end;
    ///////////////////////////////////////////////////////////////////////
    {Показывает баллон}
    //Взято с Исходников.ru [url="http://www.sources.ru"]http://www.sources.ru[/url]
    ///////////////////////////////////////////////////////////////////////
    function DZBalloonTrayIcon(const WindowHWND; const IconIDByte; const TimeoutTBalloonTimeout; const BalloonTextBalloonTitleString; const BalloonIconTypeTBalloonIconType): Boolean;
    const
    aBalloonIconTypes : array[TBalloonIconTypeof Byte = (NIIF_NONENIIF_INFONIIF_WARNINGNIIF_ERROR);
    var
    NID_50 NotifyIconData_50;
    begin
    FillChar
    (NID_50SizeOf(NotifyIconData_50), 0);
    with NID_50 do begin
    cbSize 
    := SizeOf(NotifyIconData_50);
    Wnd := Window;
    uID := IconID;
    uFlags := NIF_INFO;
    StrPCopy(szInfoBalloonText);
    uTimeout := Timeout 1000;
    StrPCopy(szInfoTitleBalloonTitle);
    dwInfoFlags := aBalloonIconTypes[BalloonIconType];
    end{with};
    Result := Shell_NotifyIcon(NIM_MODIFY, @NID_50);
    end;

    end.
  13. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    Кто нибудь поможет.
    Купил у 1С Технология создания внешних компонент. Мол с примерами. Вот только они какие-то не рабочие.
    Мож кто скинет пример DLL на Delphi или C++ Builder
    Очень нужна помощь!!!
  14. TopicStarter Overlay
    krasdok
    Offline

    krasdok Опытный в 1С

    Регистрация:
    22 июн 2011
    Сообщения:
    130
    Симпатии:
    0
    Баллы:
    26
    Помогите плиззз!!!
Похожие темы
  1. alexburn
    Ответов:
    5
    Просмотров:
    494
Загрузка...

Поделиться этой страницей