Плагины в VB
В этой статье мы рассмотрим создание и использование плагинов в Visual Basic.В качестве плагинов будут использоваться ActiveX серверы, как DLL, так иEXE. Основное различие между ними в том, что DLL серверы исполняются в пространстве запустившего их процесса, а для EXE сервера используется собственный процесс. Я не буду подробно рассматривать создание ActiveX сервера на VB, а только приведу общее описание требуемого содержания плагина.(Кстати такие плагины могут быть написаны и не на VB, главное использование указанных соглашений.
Итак плагин должен содержать, класс PCode. Он будет использоваться по умолчанию, как "ядро" плагина. Вы можете сделать ядромдругой класс, но он должен быть связан с PCode.
Будем считать, что плагин у Вас есть, и рассмотрим способ егоиспользования. Для начала некоторые объявления.
Public Const PLUGIN_LOAD_ERROR = -2
Private Declare Function CreateThread Lib "kernel32" ( _
anyThread As Any, ByVal lngSize As Long, ByVal lngStart As Long, _
ByVal lngValue As Long, ByVal lngFlags As Long, lngThread As Long) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal strName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" ( _
ByVal lngModule As Long, ByVal strName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal lngModule As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal lngHandle As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal lngHandle As Long, ByVal lngTime As Long) As Long
Private Loaded As Boolean
Теперь Рассмотрим функцию, запускающую плагин. Она работает наподобие CreateObject(вообще то она её и использует).
Public Function StartPlugin(ByVal strPluginDLL As String, _
Optional strPluginName As String, _
Optional ErrMax As Integer) As Object
Dim Result As Object
Dim ErrCounter As Integer
If ErrMax = 0 Then ErrMax = -1
If Len(strPluginName) = 0 Then
"Если не указано имя плагина - исользуем имя библиотеки
strPluginName = ClearName(strPluginDLL) & ".PCode"
End If
On Error GoTo SP_ERROR_Handler
Set StartPlugin = CreateObject(Trim$(strPluginName))
Loaded = True
Exit Function
SP_ERROR_Handler:
"Если плагин не зарегистрирован - зарегистрируем!
If Err.Number = 429 Then Reg strPluginDLL, True
If ErrMax >= 0 Then
"Если много неудачных попыток - сообщение.
ErrCounter = ErrCounter + 1
If ErrCounter > ErrMax Then MsgBox "Ошибка загрузки Plugin." & _
vbCrLf & "Файл " & strPluginDLL & vbCrLf & "Класс " & strPluginName, _
vbCritical, "Plug-ins": Loaded = False: Exit Function
Else
Exit Function
End If
Resume
End Function
Функция пытается создать объект, и если возникает ошибка, из-за того, что плагин не зарегистрирован, пытается его зарегистрировать. В этой функции устанавливается флаг Loaded чтобы можно было проверить загруженплагин или нет. Однако можно использовать вариант ... Is Nothing.
Вся "соль" в той самой процедуре, которая регистрирует плагин. Она загружает библиотеку в памятьи посредством функции CreateThread вызывает функцию Dll[Un]RegisterServer.
Private Function Reg(ByVal strReg As String, ByVal lngLoad As Long) As Long
Dim Func As String
If lngLoad Then Func = "DllReigsterServer" Else Func = "DllUnregisterServer"
Reg = LoadLibraryA(strReg)
lngLoad = CreateThread(ByVal 0, 0, ByVal GetProcAddress(Reg, Func), ByVal 0, 0, 0)
WaitForSingleObject lngLoad, 10000
CloseHandle lngLoad
FreeLibrary Reg
End Function
Ну и несколько внутренних функций.
Public Function GetLastPluginState() As Long
If Not Loaded Then GetLastPluginState = PLUGIN_LOAD_ERROR
End Function
Private Function ClearName(ByVal FullName As String) As String
Dim lTPos As Long
Dim strResult As String
strResult = FullName
lTPos = InStr(strResult, "/")
Do While lTPos > 0
strResult = Mid$(strResult, lTPos + 1)
DoEvents
lTPos = InStr(strResult, "/")
Loop
lTPos = InStr(strResult, ".")
Do
If InStr(lTPos + 1, strResult, ".") = 0 Then Exit Do
lTPos = InStr(lTPos + 1, strResult, ".")
Loop
strResult = Left$(strResult, lTPos - 1)
ClearName = strResult
End Function
