1

Тема: VBScript: регистрация COM-библиотек с помощью dynwrap.dll и Win32API

Автор скрипта - Poltergeyst.
Альтернатива утилите regsvr32.exe, работает в OC Win98/Me и WinXP. Потребуется библиотека dynwrap.dll.

'Нет гарантий!Используете на свой страх и риск.
'--------------------------------------------------------------------------------------------
'Этот скрипт предназначен для регистрации поставщиков ActiveX
'в реестре и является альтернативным аналогом утилиты regsvr32.exe
'--------------------------------------------------------------------------------------------
'Требуется предварительно зарегистрированная библиотека dynwrap.dll
'OC Win98/Me
'--------------------------------------------------------------------------------------------
'Чтобы эффективно задействовать этот код и встроить контекстную
'команду для Dll файлов в меню проводника,добавьте в реестр 
'следующие данные(формат reg файла):
'
'    [HKEY_CLASSES_ROOT\.dll]
'    @="dllfile"

'    [HKEY_CLASSES_ROOT\dllfile\shell]
'    [HKEY_CLASSES_ROOT\dllfile\shell\Регистрировать DLL]
'    [HKEY_CLASSES_ROOT\dllfile\shell\Регистрировать DLL\command]
'    @="Wscript.exe C:\\...\\regSvr.vbs \"%1\" r"

'    [HKEY_CLASSES_ROOT\dllfile\shell\Отменить регистрацию DLL]
'    [HKEY_CLASSES_ROOT\dllfile\shell\Отменить регистрацию DLL\command]
'    @="Wscript.exe C:\\...\\regSvr.vbs \"%1\" u"

'а для конкретного случая просто создайте ярлык вида:
'    regSvr.vbs "путь к DLL или OCX файлу" <параметр>
'где <параметр>-r для регистрации,u для отмены регистрации DLL.

'То же самое должно работать и для OCX файлов.
'--------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------
if WScript.Arguments.Count=0 then WScript.Quit(-1)

fileName=WScript.Arguments(0)
param    =WScript.Arguments(1)

    if param="r" then entry="DllRegisterServer"
    if param="u" then entry="DllUnregisterServer"
    
    registerActiveX(fileName)

'--------------------------------------------------------------------------------------------
'[Регистрация сервера ActiveX]

function registerActiveX(fObj)
'-----------------------------------------------
'[Инициация библиотеки в память]
    
set dllWrap=CreateObject("DynamicWrapper")
    
'Регистрация вызова API
dllWrap.Register _
    "kernel32.DLL", _
    "LoadLibraryA", _
    "i=s", _
    "f=s", _
    "r=l"
'-----------------------------------------------
'Вызов API
    hLib=dllWrap.LoadLibraryA(Cstr(fObj))
    set dllWrap=Nothing
'-----------------------------------------------
if hLib=0 then 
    MsgBox "Невозможно загрузить библиотеку " & fObj, _
    vbExclamation, _
    "Ошибка регистрации"
    WScript.Quit(-1)
end If
'-----------------------------------------------
'-----------------------------------------------
'[Проверка точки входа]

set dllWrap=CreateObject("DynamicWrapper")

'Регистрация вызова API
dllWrap.Register _
    "kernel32.DLL", _
    "GetProcAddress", _
    "i=ls", _
    "f=s", _
    "r=l"
'-----------------------------------------------
'Вызов API
    pAdr=dllWrap.GetProcAddress(hLib,Cstr(entry))
    set dllWrap=Nothing
'-----------------------------------------------
if pAdr=0 then 
    MsgBox "Отсутствует точка входа " & entry & _
        ".Возможно этот файл не является поставщиком ActiveX.", _
        vbExclamation, _
        "Ошибка регистрации"

        freeLibrary(hLib)    'Освобождение дескриптора
        WScript.Quit(-1)
end If
'------------------------------------------------    
'-----------------------------------------------
'[Регистрация поставщика ActiveX]

set dllWrap=CreateObject("DynamicWrapper")
        
'Регистрация вызова API
dllWrap.Register _
    Cstr(fObj), _
    Cstr(entry), _
    "f=s", _
    "r=l"    
'-----------------------------------------------
'Вызов API
    if param="r" then reg=dllWrap.DllRegisterServer()    
    if param="u" then reg=dllWrap.DllUnregisterServer()    
    set dllWrap=Nothing
'-----------------------------------------------
if reg<>0 then 
    MsgBox "Ошибка работы " & entry, _
        vbExclamation, _
        "Ошибка регистрации"

        freeLibrary(hLib)    'Освобождение дескриптора
        WScript.Quit(-1)
end If            
'-----------------------------------------------
'-----------------------------------------------
freeLibrary(hLib)    'Освобождение дескриптора        

'Контрольные сообщения
'-----------------------------------------------
if param="r" then
    MsgBox "Файл " & fObj & " является поставщиком ActiveX и зарегистрирован в реестре.", _
        vbInformation, _
        "Успешная регистрация"
end If
'-----------------------------------------------
if param="u" then
    MsgBox "Файл " & fObj & " является поставщиком ActiveX.Регистрация отменена.", _
        vbInformation, _
        "Успешная отмена регистрации"
end If
'-----------------------------------------------    

end Function


'--------------------------------------------------------------------------------------------
'[Освобождение дескриптора библиотеки (вспомогательная функция)]
function freeLibrary(hLib)
    '-------------------------------------------------------
    '[Освобождение дескриптора]        
                
    set dllWrap=CreateObject("DynamicWrapper")
            
    'Регистрация вызова API
    dllWrap.Register _
    "kernel32.DLL", _
    "FreeLibrary", _
    "i=l", _
    "f=s"
        
    'Вызов API
    dllWrap.FreeLibrary(hLib)    
    set dllWrap=Nothing

    hLib=Null

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