Советы тем, кто программирует на VB & VBA
Совет 309. Как получить сводку о файле MP3
Совет 310. Приоритетность использования оператора With
Совет 311. Следите за состоянием батарей ноутбука
Совет 312. Следите за правильным использованием типов данных
Совет 313. Как контролировать наличие кавычек в названиях
Совет 314. Вывод подсказок на панель StatusBar
Совет 315. Программное управление раскладкой клавиатуры
Совет 316. Простые алгоритмы шифрования данных
Совет 317. Как вывести информацию в элементе управления WebBrowser, не пользуясь HTML-файлом
Совет 318. Как преобразовать OLE_COLOR в фактическое значение функции RGB
Совет 319. Один из способов создания уникального строкового идентификатора
Совет 320. Как с помощью метода OpenSchema получить информацию о структуре базы данных
Совет 321. Как обнаружить неиспользуемые объекты
Совет 309. Как получить сводку о файле MP3
Вполне вероятно, что, прежде чем начать проигрывать файл формата MP3 (это можно сделать, подключив средства Windows Media Player к VB-приложению), вы захотите узнать название песни, имя исполнителя и пр. Если MP3-файл использует наиболее популярное кодирование тэгов ID3, то сделать это очень легко. Данный стандарт записывает в последние 128 байтов сводную информацию, которую можно прочитать с помощью, например, такого кода:
Private Type TagInfo Tag As String * 3 ' признак ID3 Songname As String * 30 ' название песни artist As String * 30 ' имя артиста album As String * 30 ' название альбома year As String * 4 ' год издания comment As String * 30 ' комментарий genre As String * 1 ' тип жанра End Type Dim FileName As String Dim CurrentTag As TagInfo Private Sub ReadMP3FileInfo(MP3FileName$) ' чтение сводки MP3-файла On Error Resume Next Open FileName For Binary As #1 With CurrentTag Get #1, FileLen(FileName) - 127, CurrentTag Close #1 If Not .Tag = "TAG" Then MsgBox "Это не стандарт ID3" Exit Sub End If ' перезапись в текстовые поля, удаляя пробелы справа txtTitle = RTrim(.Songname) txtArtist = RTrim(.artist) txtAlbum = RTrim(.album) txtYear = RTrim(.year) txtComment = RTrim(.comment) ' если есть список жанров, то можно установить индекс Combo1.ListIndex = .genre - 1 End With End Sub
Совет 310. Приоритетность использования оператора With
Применение оператора With позволяет не только сократить время на ввод программы и улучшить читабельность кода, но и повысить скорость выполнения приложения. Использовать With можно как для объектов, так и для переменных пользовательского типа (User-Defined type, UDT). Вопрос заключается в следующем: для какого типа данных лучше использовать With? Ответ: в первую очередь для объектов, так как в этом случае будет снижаться время доступа к их свойствам. Например, у вас имеется структура, в которой хранится набор параметров:
Private Type TBtnSettings BgColor As Long FontSize As Integer End Type Private mOrigSettings As TBtnSettings
Вам нужно присвоит эти параметры свойствам командной кнопки. Конструкция:
Private Sub Command1_Click() ' более быстрый вариант With Command1 .BackColor = mOrigSettings.BgColor .FontSize = mOrigSettings.FontSize End With End Sub
будет работать быстрее, чем, например, такая конструкция:
Private Sub Command1_Click() ' менее быстрый вариант With mOrigSettings Command1.BackColor = .BgColor Command1.FontSize = .FontSize End With End Sub
Совет 311. Следите за состоянием батарей ноутбука
Элемент управления SysInfo, поставляемый с VB (в окне Components он называется Microsoft SysInfo Control Version 6.0 или 5.0), довольно редко применяется разработчиками. И напрасно, ведь он позволяет получать информацию о параметрах и событиях операционной системы, событиях plug-and-play и др. В данном случае мы покажем, как с его помощью можно прочитать сведения о состоянии батарей ноутбука.
Свойство ACStatus позволяет узнать, используется ли в данный момент батарея для питания:
Select Case SysInfo1.ACStatus Case 0 MsgBox "Питание сейчас не от батареи" Case 1 MsgBox "Питание сейчас не от батареи" Case 255 MsgBox "Состояние батареи неизвестно" End Select
Свойство BatteryLifePercent определяет процент зарядки батареи:
Dim PerCentLeft As String If SysInfo1.BatteryLifePercent <> 255 Then PerCentLeft = SysInfo1.BatteryLifePercent MsgBox PerCentLeft & "%" Else MsgBox "Состояние заряда батареи неизвестно" End If
Если ноутбук питается сейчас от батареи, то полезно узнать, сколько времени еще можно работать с ней:
If SysInfo1.BatteryLifeTime <> &HFFFFFFFF Then MsgBox "Осталось работать" & _ Format(TimeSerial(0, 0, SysInfo1.BatteryLifeTime), "h:mm") Else MsgBox "Нельзя определить время работы батареи" End If
Совет 312. Следите за правильным использованием типов данных
Мы уже не раз отмечали, что Visual Basic позволяет разработчику весьма вольное использование типов переменных, выполняя неявное преобразование. Например, такая конструкция в VB вполне допустима и даже выдает правильный результат:
Dim iValue As Integer Text1.Text = "5" iValue = 4 * Text1.Text Print iValue ' будет напечатано 20
Однако с точки зрения теории языков программирования такое смешение типов в одном выражении является грубой ошибкой. К сожалению, многие разработчики привыкли к подобному стилю VB и считают его очень удобным, поскольку в данном случае нетнеобходимости тратить время на использование специальных функций преобразования типов данных. Следуя такому подходу, можно написать следующий код:
Select Case Text1.Text Case 1 to 12 MsgBox "Допустимая величина" Case Else MsgBox "Недопустимая величина" End Select
При этом можно подумать, что при вводе в текстовое поле величины от 1 до 12 будет выдаваться сообщение “Допустимая величина”. Однако на самом деле код будет работать иначе: “Допустимая величина” будет выдаваться только для значений 1, 10, 11 и 12. Для чисел от 2 до 9 пользователь получит сообщение “Недопустимая величина”.
Трудно сказать, почему в случае арифметического выражения для строки “5” преобразование выполняется верно, а в операторе Select — неверно. Следует только иметь в виду, что при использовании неявного преобразования могут возникнуть подобные проблемы. Придерживаясь же классических принципов программирования и потратив немного времени на ввод нескольких дополнительных символов, вы легко избежите этих проблем. Такой вариант кода будет надежно работать для любых числовых значений текстового поля:
Select Case Val(Text1.Text) Case 1 to 12 MsgBox "Допустимая величина" Case Else MsgBox "Недопустимая величина" End Select
Совет 313. Как контролировать наличие кавычек в названиях
Наш читатель из Томска прислал такой вопрос: “У меня в базе данных есть таблица “Поставщики”. В ней имеется поле “Название”, в котором названия фирм могут содержать кавычки, например <ООО "МММ">. Мне необходимо сформировать строку SELECT с критерием поиска WHERE [Название] = ..., но когда я делаю это, у меня возникает синтаксическая ошибка (лишние кавычки):
WHERE [Название] = "ООО "МММ""
Вопрос сформулирован таким образом, что не совсем понятно, как читатель формирует строку SELECT и зачем использует такой вариант поиска. Поэтому попробуем рассмотреть эту проблему с разных сторон.
1. Обработка символьных данных, внутри которых содержатся двойные кавычки, представляет некоторые трудности, так как этот символ используется в качестве скобок для написания символьных литералов. Решается эта проблема общепринятым способом: внутри литерала каждая кавычка записывается дважды. Поэтому при синтаксическом разборе текста исходного кода первая кавычка считается правой скобкой, далее каждая пара заменяет одну внутри строки, непарная является левой скобкой. Соответственно, чтобы присвоить приведенной выше переменной название фирмы, нужно написать:
CompanyName$ = "OOO ""MMM"""
Отметим, что такая запись не очень хорошо воспринимается визуально, поэтому при использовании большого числа подобных строк можно вместо двойных кавычек применять какой-то другой символ, а потом воспользоваться простой подпрограммой замены символов. Например, в VB6 это может выглядеть таким образом (при вводе мы используем одинарные кавычки):
CompanyName$ = Replace34("OOO 'MMM'") ... Sub Replace34$ (Word$) Replace34$ = Replace(Word$, Chr$(39), Chr$(34)) End Sub
2. С учетом проблемы с двойными кавычками многие языки допускают в качестве логических скобок для строковых литералов использование или двойных, или одинарных кавычек. В том числе и SQL-обращения.
В нашем случае оператор должен выглядеть следующим образом (чтобы были видны кавычки, я использую имя <ООО "МММ" O>):
SELECT ... Where Firm = 'ООО "МММ" О'
Соответственно
обращение к набору данных будет выглядеть
так:
Data1.RecordSource = "SELECT... = 'OOO ""МММ"" О' "
Для иллюстрации проведем небольшой тестовый пример таблицы с такими записями названий фирм:
OOO "MMM" OOO 'MMM' OOO MMM OOOMMM
Чтобы найти первую фирму, нужно сделать обращение типа:
Data1.RecordSource = "SELECT... = 'OOO ""МММ"" О' "
Чтобы найти вторую:
Data1.RecordSource = "SELECT... = ""OOO 'МММ' О"" "
3. Немного сложнее обстоит дело, когда название искомой фирмы вводится в поле, то есть заранее неизвестно, содержит оно двойные или одинарные кавычки. В этом случае при формировании SQL-запроса нужно определить, какие кавычки содержатся в наименовании, и соответственно выбрать другие. Для этого можно предложить такой вариант:
' FindFirm$ -- искомое название. If Insrt (FindFirm$, Crh$(34)" Then d$ = Chr$(39) ' название содержит двойные кавычки Else d$ = Chr$(34) ' название содержит двойные кавычки End If SQL$ = "Select ... Where Firm = " & d$ & FindFirm$ & d$
Очевидно, что в подобных запросах проблема возникает при наличии в названии кавычек двух типов. (Хотя, наверное, и тут можно как-то исхитриться.)
4. Вообще-то лучше осуществлять поиск так, чтобы он не зависел от кавычек в названии. Тут может пригодиться оператор Like (подробно его работа рассматривается в статье “Особенности работы со строковыми переменными в Visual Basic”, КомпьютерПресс 1’2000).
Например, для приведенной выше базы из четырех записей запрос:
Firm Like 'OOO*MMM*'
найдет все четыре записи, а запрос:
Firm Like 'OOO *MMM*'
найдет все первые три записи.
Совет 314. Вывод подсказок на панель StatusBar
Как известно, при передаче фокуса элементу управления на экран может выдаваться подсказка (с помощью свойства ToolTipText, которое есть у многих элементов управления). Иногда бывает полезным, чтобы такая подсказка появлялась в строке статуса. Это делается следующим образом:
Private Sub Text1_GotFocus() StatusBar1.Panels(1).Text = "Text1" ' вывести текст End Sub Private Sub Text1_LostFocus() StatusBar1.Panels(1).Text = "" ' очистить End Sub
Совет 315. Программное управление раскладкой клавиатуры
Обычно переключение раскладки клавиатуры с русского языка на английский и наоборот выполняется при помощи комбинации “горячих” клавиш. Но иногда удобнее для установки каждой раскладки использовать определенную комбинацию. Это тем более полезно при работе с многоязычными документами (поддержка трех языков в странах бывшего СССР — дело обычное). Короче говоря, вопрос упирается в то, как программно устанавливать нужную раскладку клавиатуры. При работе с пакетами MS Office это делается очень просто:
Application.Keyboard (LangID)
Однако такую установку можно провести только для списка раскладок клавиатуры, определенного в панели инструментов. Здесь нужно иметь в виду, что код региональной установки может не соответствовать значению параметра региона. Например, для моего компьютера код для русской раскладки — &h04190419, то есть региональный код дублируется в старшей и младшей частях числа.
Уточнить конкретный код раскладки можно очень просто: установить нужный режим, а потом определить его числовое выражение:
LangIDCurrentKeyBoard = Application.Keyboard
При создании приложения с помощью обычного VB подобные операции (но с более широкими возможностями) выполняются путем использования функций Win API.
Совет 316. Простые алгоритмы шифрования данных
Существует немало алгоритмов шифрования-дешифрования информации. И, наверное, еще много методов будет придумано в будущем. Мы же предлагаем использовать для подобных задач достаточно простой вариант на основе известной логической операции XOR, принцип которой описывается следующими формулами:
<Шифрованный код> = <Исходный код> XOR
<Шифр>
<Исходный код> = <Шифрованный код> XOR
<Шифр>
Таким образом, кодирование и последующее декодирование информации выполняются с помощью одного числового кода (шифра) и операции XOR. В программной реализации это выглядит следующим образом:
SourceArray() As Byte — байтовый массив с исходной
информацией
KeyWord() As Byte —
байтовый массив с ключом-шифром
ResultArray()
As Byte — байтовый массив с зашифрованной
информацией
Шифрование и дешифрирование данных выполняются с помощью одной и той же процедуры:
' получаем зашифрованный массив ResultArray = EncryptDecrypt(SourceArray, KeyWord) ' записываем шифрованный массив и в нужный момент восстанавливаем SourceArray = EncryptDecrypt(ResultArray, KeyWord)
Процедура шифрования выглядит следующим образом:
' Public Function EncryptDecrypt _ (Source() As Byte, KeyWord() As Byte) As Byte() ' ' кодирование-декодирование массива ReDim Result(LBound(Source) To UBound(Source)) As Byte Dim k&, klw&, kuw&, k1& klw = LBound(KeyWord): kuw = UBound(KeyWord): k1 = kuw For k = LBound(Source) To UBound(Source) k1 = k1 + 1: If k1 > kuw Then k1 = klw Result(k) = Source(k) Xor KeyWord(k1) Next EncryptDecrypt = Result() End Function
Здесь следует сделать несколько замечаний.
1. Если вы кодируете информацию, то имеет смысл следить за целостностью данных. Ведь “враг”, хотя и не поймет содержание данных, но навредить может, испортив их (а вы и не заметите этого!). Эта проблема решается, например, вычислением контрольной циклической суммы:
Dim SourceCycle(0 To 3) As Byte Call CycleSumma(SourceArray, SourceCycle) Public Sub CycleSumma(Source() As Byte, Cycle() As Byte) ' вычисление циклической суммы Dim k&, nc% For k = LBound(Source) To UBound(Source) nc = k Mod 4 Cycle(nc) = Cycle(nc) Xor Source(k) Next End Sub
2. Следует иметь в виду, что приведенный здесь алгоритм будет хорошо работать для достаточно неоднородного массива исходных данных (с низким значением эндотропии). Однако если массив состоит из одних нулей, то шифрованный будет состоять из легко интерпретируемой последовательности кодового массива. То есть такой алгоритм плохо подходит для файлов MS Office, в которых имеются огромные пустоты, заполненные байтами с тривиальными нулями или двоичными единицами. Но для обычных текстовых данных и тем более — для архивных файлов, где эндотропия практически равна единице, он будет просто идеальным.
3. Нужно быть очень внимательным при использовании символьных данных ключа и исходного массива. Например, если у вас есть такие исходные данные:
strSource$ = "Исходный текст, который мы хотим закодировать" strKey$="Шифр"
то преобразование строки в байтовый массив выглядит очень неудачными:SourceArray()
= strSource$
KeyWord()= strKey$
Дело в том, что в этом случае мы получаем кодировку Unicode, где каждый нечетный байт будет иметь фиксированное значение (появляется однородность массива, которую лучше избегать). В этом случае лучше работать с использованием ANSI-кода:
SourceArray() = StrConv(strSource$, vbFromUnicode) KeyWord()= StrConv(strKey$, vbFromUnicode)
4. Очевидно, что вы можете повышать уровень кодирования простым увеличением числа байтов в кодовом массиве, не принимая во внимание ограничения ФАПСИ на длину ключа. Например, кодом может быть достаточно длинная текстовая фраза: “Дети в школу собирайтесь, петушок пропел давно”.
Совет 317. Как вывести информацию в элементе управления WebBrowser, не пользуясь HTML-файлом
При использовании элемента управления WebBrowser в VB можно вывести информацию таким образом, чтобы конечный пользователь не имел к ней доступа. Для этого следует просто вставить HTML-код непосредственно в элемент управления.
Продемонстрируем данный метод на следующем примере. Вначале создадим пустой документ внутри элемента управления WebBrowser, а затем введем туда HTML-текст, не используя никакого внешнего HTML-файла. Таким образом мы не только упрощаем работу, но и защищаем свой HTML-код: если пользователь выберет команду ViewSource для просмотра кода, то все, что он увидит, будет <HTML></HTML>.
Option Explicit Property Set Doc(Document As Object) Set CurrentDoc = Document End Property Private Sub Form_Load() Dim strHTMLText As String ' Создаем пустой документ в ' элементе управления WebBrowser WebBrowser1.Navigate2 "about:Blank" ' Web-браузеру может понадобиться некоторое ' время для обработки каждой команды DoEvents On Error GoTo WaitAwhileLonger ' Устанавливаем цвет фона документа WebBrowser1.Document.body.bgcolor = "#000000" ' Задаем HTML-текст с помощью кода ' или информации из базы данных strHTMLText = "<html>" & vbCrLf & "<head>" & _ vbCrLf & "<title>Наш проект</title>" & _ vbCrLf & "</head>" & vbCrLf & _ "<body><p align=""center""> " & _ "<font face=""Arial"" size=""5"" " & _ "color=""#FFFFFF""><strong> " & _ "Советы по VB & VBA</strong></font> " & _ "</p><p align=""center""> " & _ "<a href=""http://www.visual.2000.ru""> " & _ "Посетите наш сайт</a></p></body>" & _ vbCrLf & "</html>" strHTMLText = strHTMLText & "<head>" & vbCrLf ' Отправляем HTML-текст непосредственно ' в элемент управления WebBrowser WebBrowser1.Document.body.innerhtml = strHTMLText Exit Sub ' WaitAwhileLonger: Debug.Print Hex(Err.Number), Err.Description DoEvents Resume End Sub
Элементу управления WebBrowser иногда требуется некоторая “поддержка”, чтобы полностью закончить выполнение задания, прежде чем перейти к следующему. Поэтому мы используем здесь ловушку ошибок, которая позволяет компоненту WebBrowser “перевести дух”, а затем вновь вернуться к работе.
Совет 318. Как преобразовать OLE_COLOR в фактическое значение функции RGB
Вы когда-нибудь пытались передать системную VB-константу, задающую цвет (например, vbButtonFace), в API-функцию? На практике часто бывает необходимо использовать системные цвета при вызове GDI-интерфейса (Graphical Device Interface — Интерфейс графических устройств), а вы предпочитаете работать с системными цветовыми VB-константами. Проблема заключается в том, что GDI-интерфейс не знает, что делать с такими константами, и в результате вы всегда получаете черный цвет.
Мы предлагаем вам следующее решение. Используйте API-функцию OleTranslateColor, которая читает любую из таких констант, а затем преобразует ее в буквенные RGB-цвета, которые понятны для GDI-интерфейса. Это можно сделать так:
Option Explicit Private Declare Function OleTranslateColor _ Lib "oleaut32.dll" (ByVal lOleColor As Long, _ ByVal lHPalette As Long, lColorRef As _ Long) As Long Public Function TranslateColor(inCol As _ OLE_COLOR) As Long ' Dim retCol As Long OleTranslateColor inCol, 0&, retCol TranslateColor = retCol End Function
Теперь просто вызовите функцию TranslateColor, используя конкретную системную цветовую константу, для получения необходимого вам цвета, например так:
Private Sub Form_Load() Dim newColor As Long newColor = TranslateColor(&H80000001) Form1.BackColor = newColor End Sub
Обратите внимание, что если вы передаете в функцию TranslateColor стандартное значение функции RGB, то оно возвращается в неизменном виде. Поэтому нет смысла беспокоиться о том, в каком виде хранить значение цвета — как системную константу или как фактическое значение цвета.
Совет 319. Один из способов создания уникального строкового идентификатора
Если существует потребность в уникальном строковом идентификаторе, а у вас нет возможности проверить, является ли сгенерированный вами идентификатор уникальным, воспользуйтесь идентификатором Universally Unique ID (UUIID) или Globally Unique ID (GUID). UUID представляет собой 128-битовое число, которое генерируется на базе текущего времени и сетевой интерфейсной платы (Network Interface Card — NIC) вашего компьютера. Это гарантирует, что получаемая строка будет уникальной (по крайней мере, в рамках вашей сети и до наступления 3400 года).
Следующая функция создает идентификатор UUID и преобразовывает его в 36-байтовые строки. Для этого в текст модуля вставьте такой код:
Option Explicit Private Declare Function UuidCreate Lib _ "rpcrt4.dll" (pId As UUID) As Long Private Declare Function UuidToString Lib _ "rpcrt4.dll" Alias "UuidToStringA" _ (uuidID As UUID, ppUuid As Long) As Long Private Declare Function RpcStringFree Lib _ "rpcrt4.dll" Alias "RpcStringFreeA" _ (ppStringUiid As Long) As Long Private Declare Function CopyMemory Lib _ "kernel32.dll" Alias "RtlMoveMemory" _ (pDst As Any, pSrc As Any, ByVal nSize _ As Long) As Long Private Type UUID Data1 As Long Data2 As Long Data3 As Long Data4(8) As Byte End Type Public Function GenUuid(sUuid As String) As Boolean Const RPC_S_OK As Long = 0 Const SZ_UUID_LEN As Long = 36 Dim uuidID As UUID Dim sUid As String Dim ppUuid As Long ' sUid = String(SZ_UUID_LEN, 0) If UuidCreate(uuidID) = RPC_S_OK Then If UuidToString(uuidID, ppUuid) = _ RPC_S_OK Then CopyMemory ByVal sUid, ByVal ppUuid, _ SZ_UUID_LEN If RpcStringFree(ppUuid) = RPC_S_OK Then sUuid = sUid GenUuid = True End If End If End If End Function
Использовать эту функцию можно, например, так:
Dim sId As String Call GenUuid(sId) MsgBox "Идентификатор = " & sId
Несомненно, вы найдете лучшее применение созданным таким образом идентификаторам, чем просто выводить их на экран. Помните, однако, что существует потенциальная возможность с помощью подобных идентификаторов однозначно определить, на какой машине они были сгенерированы. А это уже связано с вопросами безопасности, хотя, возможно, они не имеют для вас никакого значения.
Совет 320. Как с помощью метода OpenSchema получить информацию о структуре базы данных
Метод OpenSchema объекта Connection позволяет получить информацию о структуре базы данных от провайдера. Иными словами, он дает возможность просматривать коллекции данных, хранящиеся в базе данных OLE DB, не составляя перечня самих коллекций. Этот метод возвращает набор данных с полями, описывающими членов коллекции. Так, если использовать метод OpenSchema с запросом adSchemaTables и провайдером данных Jet 4.0, мы получим информацию о локальных таблицах, связанных таблицах, передаваемых запросах, системных таблицах и таблице Access. В вашем распоряжении свыше 30 типов запросов, с помощью которых можно получить информацию о содержимом источника данных OLE DB. Помимо этого запрос adSchemaTables возвращает информацию о таких знакомых объектах баз данных, как индексы, основные ключи, внешние ключи, процедуры и разрезы данных.
Следующий пример демонстрирует, как с помощью метода OpenSchema и провайдера Jet 4.0 получить список разрезов данных:
Option Explicit Public Sub OpenSchemaX() Dim cnn1 As New ADODB.Connection Dim rstSchema As ADODB.Recordset cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0; _ Data Source=C:\VB-DB\Nwind.mdb;" Set rstSchema = cnn1.OpenSchema(adSchemaTables) ' Просмотр только разрезов данных; другие ' критерии выбора включают TABLE, LINK, ' PASS-THROUGH, ACCESS, TABLE и SYSTEM TABLE Do Until rstSchema.EOF If rstSchema.Fields("TABLE_TYPE") = "VIEW" Then MsgBox "View name: " & rstSchema.Fields _ ("TABLE_NAME") & vbCr End If rstSchema.MoveNext Loop rstSchema.Close cnn1.Close End Sub Private Sub Form_Load() Call OpenSchemaX End Sub
Совет 321. Как обнаружить неиспользуемые объекты
Неправильное использование объектов или ссылок на объекты может привести к тому, что они останутся в оперативной памяти, снижая тем самым быстродействие приложения. Чтобы избежать подобных ситуаций и найти “плохой код” в своей программе, можно применять системные утилиты и инструменты третьих фирм. Однако это не самый простой путь. Мы рекомендуем воспользоваться технологией обработки событий, имеющейся в VB5/VB6.
Создайте новый проект ActiveX DLL, содержащий один класс ResidentObjs.cls. Опишите некоторое событие в разделе Declarations для этого класса. Затем добавьте метод, который запускает данное событие, и назовите полученную подпрограмму DetectAllObjects:
Option Explicit Public Event ObjectNotification() Public Sub DetectAllObjects() DoEvents RaiseEvent ObjectNotification End Sub
Создайте библиотеку командой File|Make ListObjects.dll.
Теперь в своем приложении добавьте ссылку к только что созданной библиотеке, а в BAS-модуле опишите глобальную переменную как ResidentObjs. Затем напишите код, который будет создавать экземпляр этой переменной при инициализации приложения:
Sub Main() Set oListObject = New ListObjects.ResidentObjs End Sub
В каждом классе своего проекта опишите переменную ResidentObjs с помощью ключевого слова WithEvents. Потом установите эту объектную переменную как глобальную переменную для инициализации класса или другой функции класса, которая вызывается каждый раз при создании объекта данного класса. В функции события можно написать любой код, который бы сообщал о текущем экземпляре объекта. Например, вы можете добавить Debug.Print или какой-либо другой код, записывающий имя класса в файл.
Теперь вы можете вызвать подпрограмму DetectAllObjects из любого места кода приложения. При этом количество вызовов функции соответствует количеству объектов, находящихся в оперативной памяти в текущий момент времени.
Как же работает описываемый здесь механизм? События — это разновидность анонимных коммуникационных сообщений, которые отправляются каждому экземпляру объекта в приложении. Благодаря этому с помощью предложенного нами достаточно простого кода можно легко обнаружить недопустимые объекты.
КомпьютерПресс 10'2000