1

Тема: 1Cv7.7: вызов Win32 API через VBA MS Office

Здесь будет приведена процедура на встроенном языке 1С:Предприятия v7.7, которая удаляет меню "Файл", "Сервис", "Окна" и "Помощь" из главного меню программы 1С (штатными способами этого зделать нельзя). Процедура требует наличия на машине MS Excel. Трудно сказать, какова практическая ценность этого конкретного кода, но на мой взгляд, интересна сама идея - имея на машине MS Office, можно легко вызывать Win32 API из любых скриптовых языков.

Процедура глУбратьМенюФайл(ExcelApp)
    ПолныйЗаголовокСистемы="1С:Предприятие - "+СокрЛП(Метаданные.Идентификатор)+": "+ЗаголовокСистемы();
    ExcelApp.DisplayAlerts = 0; // не выводить сообщений и вопросов
    WorkBook = ExcelApp.WorkBooks.Add(); // создание новой книги Excel
    WorkBook.Worksheets.Add(); // создание нового листа в книге Excel
    //добавление нового модуля VBA в книгу Excel и получение ссылки на его код:
    ы = ExcelApp.VBE.ActiveVBProject.VBComponents.Count;
    ExcelApp.VBE.ActiveVBProject.VBComponents.Add(1);
    CodeModule = ExcelApp.VBE.ActiveVBProject.VBComponents.Item(ы + 1).CodeModule;
    //************************************************************************************************
    //=>>Добавление кода VBA *************************************************************************
    //Объявления нужных Win32 API:
    CodeModule.InsertLines(1,  "Public Declare Function GetDesktopWindow Lib ""user32"" () As Long");
    CodeModule.InsertLines(2,  "Public Declare Function EnumChildWindows Lib ""user32"" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long");
    CodeModule.InsertLines(3,  "Public Declare Function GetWindowTextLength Lib ""user32"" Alias ""GetWindowTextLengthA"" (ByVal hwnd As Long) As Long");
    CodeModule.InsertLines(4,  "Public Declare Function GetWindowText Lib ""user32"" Alias ""GetWindowTextA"" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long");
    CodeModule.InsertLines(5,  "Public Declare Function GetMenu Lib ""user32"" (ByVal hwnd As Long) As Long");
    CodeModule.InsertLines(6,  "Public Declare Function GetMenuItemCount Lib ""user32"" (ByVal hMenu As Long) As Long");
    CodeModule.InsertLines(7,  "Public Declare Function RemoveMenu Lib ""user32"" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long");
    CodeModule.InsertLines(8,  "Public Declare Function GetMenuItemInfo Lib ""user32"" Alias ""GetMenuItemInfoA"" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpmii As MENUITEMINFO) As Long");
    CodeModule.InsertLines(9,  "Public Declare Function SetTimer Lib ""user32"" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long");
    CodeModule.InsertLines(10, "Public Declare Function KillTimer Lib ""user32"" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long");
    CodeModule.InsertLines(11, "Public Declare Function DrawMenuBar Lib ""user32"" (ByVal hwnd As Long) As Long");
    //Объявления глобальных переменных, констанот и типов:
    CodeModule.InsertLines(12, "Public count_wnd As Long"); //количество найденных окон
    CodeModule.InsertLines(13, "Public hwnd_1C As Long"); //хэндл окна 1С
    CodeModule.InsertLines(14, "Public uIDEvent As Long"); //идентификатор таймера
    CodeModule.InsertLines(15, "Public Type hwnd_app"); //структура, хранящая хэндл и заголовок окна
    CodeModule.InsertLines(16, "    hwnd As Long");
    CodeModule.InsertLines(17, "    caption As String * 1024");
    CodeModule.InsertLines(18, "End Type");
    CodeModule.InsertLines(19, "Public WindowSys() As hwnd_app"); //массив, хранящий хэндлы и заголовки найденных окон
    CodeModule.InsertLines(20, "Public Type MENUITEMINFO"); //структура, хранящая информацию об элементе меню
    CodeModule.InsertLines(21, "    cbSize As Long");
    CodeModule.InsertLines(22, "    fMask As Long");
    CodeModule.InsertLines(23, "    fType As Long");
    CodeModule.InsertLines(24, "    fState As Long");
    CodeModule.InsertLines(25, "    wID As Long");
    CodeModule.InsertLines(26, "    hSubMenu As Long");
    CodeModule.InsertLines(27, "    hbmpChecked As Long");
    CodeModule.InsertLines(28, "    hbmpUnchecked As Long");
    CodeModule.InsertLines(29, "    dwItemData As Long");
    CodeModule.InsertLines(30, "    dwTypeData As String");
    CodeModule.InsertLines(31, "    cch As Long");
    CodeModule.InsertLines(32, "    hbmpItem As Long");
    CodeModule.InsertLines(33, "End Type");
    CodeModule.InsertLines(34, "Public Const MIIM_STRING = &H40");
    CodeModule.InsertLines(35, "Public Const MF_REMOVE = &H1000&");
    CodeModule.InsertLines(36, "Public Const MF_BYPOSITION = &H400");
    //Процедура, находящая хэндл окна 1С:
    CodeModule.InsertLines(37, "Public Sub Find1C_Window()");
    CodeModule.InsertLines(38, "    hwndDesktop = GetDesktopWindow()"); //получение хэндла окна рабочего стола
    CodeModule.InsertLines(39, "    EnumChildWindows hwndDesktop, AddressOf EnumChildProc, ByVal 0&"); //перечисление дочерних окон рабочего стола
    CodeModule.InsertLines(40, "    For i = 1 To count_wnd");
    CodeModule.InsertLines(41, "        If (InStr(WindowSys(i).caption, """+ПолныйЗаголовокСистемы+""") > 0) Then"); //найдено окно 1С
    CodeModule.InsertLines(42, "            hwnd_1C = WindowSys(i).hwnd"); //получение хэндла окна 1С
    CodeModule.InsertLines(43, "            Exit For");
    CodeModule.InsertLines(44, "        End If");
    CodeModule.InsertLines(45, "    Next");
    CodeModule.InsertLines(46, "End Sub");
    //Функция перечисления дочерних окон:
    CodeModule.InsertLines(47, "Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long");
    CodeModule.InsertLines(48, "    Dim sSave As String");
    CodeModule.InsertLines(49, "    sSave = Space$(GetWindowTextLength(hwnd) + 1)");
    CodeModule.InsertLines(50, "    GetWindowText hwnd, sSave, Len(sSave)"); //получение заголовка окна
    CodeModule.InsertLines(51, "    sSave = Left$(sSave, Len(sSave) - 1)");
    CodeModule.InsertLines(52, "    If sSave <> """" Then");
    CodeModule.InsertLines(53, "        count_wnd = count_wnd + 1"); //увеличение счётчика окон
    CodeModule.InsertLines(54, "        ReDim Preserve WindowSys(count_wnd)"); //помещение найденного окна в массив
    CodeModule.InsertLines(55, "        WindowSys(count_wnd).hwnd = hwnd");
    CodeModule.InsertLines(56, "        WindowSys(count_wnd).caption = sSave");
    CodeModule.InsertLines(57, "    End If");
    CodeModule.InsertLines(58, "    EnumChildProc = 1");
    CodeModule.InsertLines(59, "End Function");
    //Процедура перечисления и удаления нужных колонок меню:
    CodeModule.InsertLines(60, "Public Sub DeleteColMenu()");
    CodeModule.InsertLines(61, "    hMenu = GetMenu(hwnd_1C)"); //получение хэндла меню окна 1С
    CodeModule.InsertLines(62, "    nCnt = GetMenuItemCount(hMenu)"); //получение количества колонок меню окна 1С
    CodeModule.InsertLines(63, "    Flag = 0");
    CodeModule.InsertLines(64, "    For j = nCnt - 1 To 0 Step -1"); //перечисление колонок меню
    CodeModule.InsertLines(65, "        Dim MII As MENUITEMINFO");
    CodeModule.InsertLines(66, "        MII.cbSize = Len(MII)");
    CodeModule.InsertLines(67, "        MII.fMask = MIIM_STRING");
    CodeModule.InsertLines(68, "        GetMenuItemInfo hMenu, j, True, MII"); //получение информации о пункте меню
    CodeModule.InsertLines(69, "        MII.cch = MII.cch + 100");
    CodeModule.InsertLines(70, "        MII.dwTypeData = Space(MII.cch)");
    CodeModule.InsertLines(71, "        GetMenuItemInfo hMenu, j, True, MII");
    CodeModule.InsertLines(72, "        If InStr(MII.dwTypeData, ""Файл"") > 0 Then"); //удаление меню "Файл"
    CodeModule.InsertLines(73, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
    CodeModule.InsertLines(74, "            Flag = 1");
    CodeModule.InsertLines(75, "        End If");
    CodeModule.InsertLines(76, "        If InStr(MII.dwTypeData, ""Сервис"") > 0 Then"); //удаление меню "Сервис"
    CodeModule.InsertLines(77, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
    CodeModule.InsertLines(78, "            Flag = 1");
    CodeModule.InsertLines(79, "        End If");
    CodeModule.InsertLines(80, "        If InStr(MII.dwTypeData, ""Окна"") > 0 Then"); //удаление меню "Окна"
    CodeModule.InsertLines(81, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
    CodeModule.InsertLines(82, "            Flag = 1");
    CodeModule.InsertLines(83, "        End If");
    CodeModule.InsertLines(84, "        If InStr(MII.dwTypeData, ""Помощь"") > 0 Then"); //удаление меню "Помощь"
    CodeModule.InsertLines(85, "            RemoveMenu hMenu, j, MF_BYPOSITION Or MF_REMOVE");
    CodeModule.InsertLines(86, "            Flag = 1");
    CodeModule.InsertLines(87, "        End If");
    CodeModule.InsertLines(88, "    Next");
    CodeModule.InsertLines(89, "    If Flag = 1 Then");
    CodeModule.InsertLines(90, "        DrawMenuBar hwnd_1C");
    CodeModule.InsertLines(91, "    End If");
    CodeModule.InsertLines(92, "End Sub");
    //Процедура запуска таймера:
    CodeModule.InsertLines(93, "Public Sub InstallTimer()");
    CodeModule.InsertLines(94, "    uIDEvent = SetTimer(0, 1000000, 50, AddressOf DeleteColMenu)");
    CodeModule.InsertLines(95, "End Sub");
    //Процедура уничтожения таймера:
    CodeModule.InsertLines(96, "Public Sub DeleteTimer()");
    CodeModule.InsertLines(97, "    KillTimer 0, uIDEvent");
    CodeModule.InsertLines(98, "End Sub");
    //<<=Добавление кода VBA *************************************************************************
    //************************************************************************************************
    ExcelApp.Application.Run("Find1C_Window"); //получение хэндла окна 1С
    ExcelApp.Application.Run("InstallTimer"); //запуск таймера
КонецПроцедуры //глУбратьМенюФайл

Процедуру "глУбратьМенюФайл" следует поместить в глобальный модуль конфигурации. Также следует объявить лобальную переменную "ExcelApp". Кроме того, процедура "ПриНачалеРаботыСистемы" должна содержать такой код:

Попытка
    ExcelApp = СоздатьОбъект("Excel.Application");
    Если ExcelApp.Visible = -1 Тогда
        Предупреждение("Извините, MS Excel не должен быть запущен в момент запуска 1С:Предприятия!
        |Пожалуйста, завершите MS Excel и запустите 1С:Предприятие ещё раз.
        |Когда 1С:Предприятие будет запущено, Вы можете повторно запустить и MS Excel.");
        СтатусВозврата(0);
        Возврат;
    КонецЕсли;
    глУбратьМенюФайл(ExcelApp);
Исключение
    Предупреждение("Не удалось запустить MS Excel!");
    СтатусВозврата(0);
    Возврат;
КонецПопытки;

Кроме того, процедура "ПриЗавершенииРаботыСистемы" должна содержать такой код:

ExcelApp.Application.Run("DeleteTimer");
ExcelApp.DisplayAlerts=0;
ExcelApp.Quit();
ExcelApp="";

В VBA надо поставить флажок "Доверять доступ к Visual Basic Project" на вкладке "Надежные издатели" диалога "Безопасность": через меню "Сервис" - "Макрос" - "Безопасность...".

Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.