Проверка наличия компонентов Microsoft Office. |
Автор Виталий | |
24.01.2003 г. | |
Этот код проверит, какие компоненты Microsoft Office установлены на компьютере клиента.
Этот код проверит, какие компоненты Microsoft Office установлены на компьютере клиента. Добавте модуль в проект ( в меню Project -> Add Module) и вставте в модуль следующий текст: Public Const HKEY_CLASSES_ROOT = &H80000000 Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey _ As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _ (ByVal hKey As Long, ByVal lpValueName As String, lpReserved As Long, lptype As _ Long, lpData As Any, lpcbData As Long) As Long Declare Function RegCloseKey& Lib "advapi32" (ByVal hKey&) Public Const REG_SZ = 1 Public Const REG_EXPAND_SZ = 2 Public Const ERROR_SUCCESS = 0 Этот код вставте в вашу форму: Public Function GetRegString(hKey As Long, _ strSubKey As String, strValueName As _ String) As String Dim strSetting As String Dim lngDataLen As Long Dim lngRes As Long If RegOpenKey(hKey, strSubKey, _ lngRes) = ERROR_SUCCESS Then strSetting = Space(255) lngDataLen = Len(strSetting) If RegQueryValueEx(lngRes, _ strValueName, ByVal 0, _ REG_EXPAND_SZ, ByVal strSetting, _ lngDataLen) = ERROR_SUCCESS Then If lngDataLen > 1 Then GetRegString = Left(strSetting, lngDataLen - 1) End If End If If RegCloseKey(lngRes) <> ERROR_SUCCESS Then MsgBox "RegCloseKey Failed: " & _ strSubKey, vbCritical End If End If End Function Function FileExists(sFileName$) As Boolean On Error Resume Next FileExists = IIf(Dir(Trim(sFileName)) <> "", _ True, False) End Function Public Function IsAppPresent(strSubKey$, _ strValueName$) As Boolean IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, _ strSubKey, strValueName))) End Function Private Sub Form_Load() MsgBox "Access " & _ IsAppPresent("Access.DatabaseCurVer", "") MsgBox "Excel " & _ IsAppPresent("Excel.SheetCurVer", "") MsgBox "PowerPoint " & _ IsAppPresent("PowerPoint.SlideCurVer", "") MsgBox "Word " & _ IsAppPresent("Word.DocumentCurVer", "") End Sub |