Visual2000 · Архив статей А.Колесова & О.Павловой
Андрей Колесов, Ольга Павлова
© 2000, Андрей Колесов, Ольга ПавловаВполне вероятно, что, прежде чем начать проигрывать файл формата 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
Применение оператора 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
Элемент управления 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
Мы уже не раз отмечали, что 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
Наш читатель из Томска прислал такой вопрос:
WHERE [Название] = "ООО "МММ""
Вопрос сформулирован таким образом, что не совсем понятно, как читатель формирует строку SELECT и зачем использует такой вариант поиска. Поэтому попробуем рассмотреть эту проблему с разных сторон.
CompanyName$ = "OOO ""MMM"""
Отметим, что такая запись не очень хорошо воспринимается визуально, поэтому при использовании большого числа подобных строк можно вместо двойных кавычек применять какой-то другой символ, а потом воспользоваться простой подпрограммой замены символов. Например, в VB6 это может выглядеть таким образом (при вводе мы используем одинарные кавычки):
CompanyName$ = Replace34("OOO 'MMM'") ... Sub Replace34$ (Word$) Replace34$ = Replace(Word$, Chr$(39), Chr$(34)) End Sub
SELECT ... Where Firm = 'ООО "МММ" О'
Соответственно обращение к набору данных будет выглядеть так:
Data1.RecordSource = "SELECT... = 'OOO ""МММ"" О' "
Для иллюстрации проведем небольшой тестовый пример таблицы с такими записями названий фирм:
OOO "MMM" OOO 'MMM' OOO MMM OOOMMM
Чтобы найти первую фирму, нужно сделать обращение типа:
Data1.RecordSource = "SELECT... = 'OOO ""МММ"" О' "
Чтобы найти вторую:
Data1.RecordSource = "SELECT... = ""OOO 'МММ' О"" "
' FindFirm$ — искомое название. If Insrt (FindFirm$, Crh$(34)" Then d$ = Chr$(39) ' название содержит двойные кавычки Else d$ = Chr$(34) ' название содержит двойные кавычки End If SQL$ = "Select ... Where Firm = " & d$ & FindFirm$ & d$
Очевидно, что в подобных запросах проблема возникает при наличии в названии кавычек двух типов. (Хотя, наверное, и тут можно как-то исхитриться.)
Например, для приведенной выше базы из четырех записей запрос:
Firm Like 'OOO*MMM*'
найдет все четыре записи, а запрос:
Firm Like 'OOO *MMM*'
найдет только первые три записи.
Как известно, при передаче фокуса элементу управления на экран может выдаваться подсказка (с помощью свойства ToolTipText, которое есть у многих элементов управления). Иногда бывает полезным, чтобы такая подсказка появлялась в строке статуса. Это делается следующим образом:
Private Sub Text1_GotFocus() StatusBar1.Panels(1).Text = "Text1" ' вывести текст End Sub Private Sub Text1_LostFocus() StatusBar1.Panels(1).Text = "" ' очистить End Sub
Обычно переключение раскладки клавиатуры с русского языка на английский и наоборот выполняется при помощи комбинации "горячих" клавиш. Но иногда удобнее для установки каждой раскладки использовать определенную комбинацию. Это тем более полезно при работе с многоязычными документами (поддержка трех языков в странах бывшего СССР — дело обычное). Короче говоря, вопрос упирается в то, как программно устанавливать нужную раскладку клавиатуры. При работе с пакетами MS Office это делается очень просто:
Application.Keyboard (LangID)
Однако такую установку можно провести только для списка раскладок клавиатуры, определенного в панели инструментов. Здесь нужно иметь в виду, что код региональной установки может не соответствовать значению параметра региона. Например, для моего компьютера код для русской раскладки &h04190419, то есть региональный код дублируется в старшей и младшей частях числа.
Уточнить конкретный код раскладки можно очень просто: установить нужный режим, а потом определить его числовое выражение:
LangIDCurrentKeyBoard = Application.Keyboard
При создании приложения с помощью обычного VB подобные операции (но с более широкими возможностями) выполняются путем использования функций Win API.
Существует немало алгоритмов шифрования-дешифрования информации. И, наверное, еще много методов будет придумано в будущем. Мы же предлагаем использовать для подобных задач достаточно простой вариант на основе известной логической операции 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
Здесь следует сделать несколько замечаний.
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
strSource$ = "Исходный текст, который мы хотим закодировать" strKey$="Шифр"
но преобразование строки в байтовый массив выглядит очень неудачными:
SourceArray() = strSource$ KeyWord()= strKey$
Дело в том, что в этом случае мы получаем кодировку Unicode, где каждый нечетный байт будет иметь фиксированное значение (появляется однородность массива, которую лучше избегать). В этом случае лучше работать с использованием ANSI-кода:
SourceArray() = StrConv(strSource$, vbFromUnicode) KeyWord()= StrConv(strKey$, vbFromUnicode)
При использовании элемента управления 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 "перевести дух", а затем вновь вернуться к работе.
Вы когда-нибудь пытались передать системную 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, то оно возвращается в неизменном виде. Поэтому нет смысла беспокоиться о том, в каком виде хранить значение цвета — как системную константу или как фактическое значение цвета.
Если существует потребность в уникальном строковом идентификаторе, а у вас нет возможности проверить, является ли сгенерированный вами идентификатор уникальным, воспользуйтесь идентификатором 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
Несомненно, вы найдете лучшее применение созданным таким образом идентификаторам, чем просто выводить их на экран. Помните, однако, что существует потенциальная возможность с помощью подобных идентификаторов однозначно определить, на какой машине они были сгенерированы. А это уже связано с вопросами безопасности, хотя, возможно, они не имеют для вас никакого значения.
Метод 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
Неправильное использование объектов или ссылок на объекты может привести к тому, что они останутся в оперативной памяти, снижая тем самым быстродействие приложения. Чтобы избежать подобных ситуаций и найти "плохой код" в своей программе, можно применять системные утилиты и инструменты третьих фирм. Однако это не самый простой путь. Мы рекомендуем воспользоваться технологией обработки событий, имеющейся в 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 из любого места кода приложения. При этом количество вызовов функции соответствует количеству объектов, находящихся в оперативной памяти в текущий момент времени.
Как же работает описываемый здесь механизм? События — это разновидность анонимных коммуникационных сообщений, которые отправляются каждому экземпляру объекта в приложении. Благодаря этому с помощью предложенного нами достаточно простого кода можно легко обнаружить недопустимые объекты.