Visual2000 · Архив статей А.Колесова & О.Павловой

Советы тем, кто программирует на VB & VBA

Андрей Колесов, Ольга Павлова

© 2000, Андрей Колесов, Ольга Павлова
Авторский вариант. Статья была опубликована c незначительной литературной правкой в "КомпьютерПресс" N 10/2000, CD-ROM.


Совет 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 и зачем использует такой вариант поиска. Поэтому попробуем рассмотреть эту проблему с разных сторон.

  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", КомпьютерПресс N 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 Byt      ' байтовый массив с ключом-шифром
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.basic.visual2000.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

Cоздайте библиотеку командой File|Make ListObjects.dll.

Теперь в своем приложении добавьте ссылку к только что созданной библиотеке, а в BAS-модуле опишите глобальную переменную как ResidentObjs. Затем напишите код, который будет создавать экземпляр этой переменной при инициализации приложения:

Sub Main()
  Set oListObject = New ListObjects.ResidentObjs
End Sub

В каждом классе своего проекта опишите переменную ResidentObjs с помощью ключевого слова WithEvents. Потом установите эту объектную переменную как глобальную переменную для инициализации класса или другой функции класса, которая вызывается каждый раз при создании объекта данного класса. В функции события можно написать любой код, который бы сообщал о текущем экземпляре объекта. Например, вы можете добавить Debug.Print или какой-либо другой код, записывающий имя класса в файл.

Теперь вы можете вызвать подпрограмму DetectAllObjects из любого места кода приложения. При этом количество вызовов функции соответствует количеству объектов, находящихся в оперативной памяти в текущий момент времени.

Как же работает описываемый здесь механизм? События — это разновидность анонимных коммуникационных сообщений, которые отправляются каждому экземпляру объекта в приложении. Благодаря этому с помощью предложенного нами достаточно простого кода можно легко обнаружить недопустимые объекты.

В начало статьи