[_mikka]

Добрый день уважаемые, возник вопрос, как через VBA узнать какие версии автокада установлены на машине?
А в идеале и какие запущены?

[bargool]

Из VBA есть доступ к реестру? ИМХО только там можно узнать, какие версии установлены
Коллекция ключей AutoCAD в реестре

[_mikka]

Спасибо большое это я знаю, но этим путем мне пройти не удалось...
Моих знаний не хватило, что бы на VBA вытащить эти ключи из реестра...
Может быть у кого нибудь получилось...

[bargool]

слегка погуглил
http://www.devx.com/vb2themax/Tip/18726 - может служить отправной точкой?

[_mikka]

Спасибо, вот результат:

Код:

[Выделить все]

Option Explicit
 
Private Const MAX_PATH As Long = 260
 
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003
Private Const HKEY_PERFORMANCE_DATA As Long = &H80000004
Private Const HKEY_CURRENT_CONFIG As Long = &H80000005
 
Private Const KEY_ALL_ACCESS = &H3F
Private Const KEY_READ As Long = &H20019
 
Private Const ERROR_SUCCESS As Long = 0
 
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Declare Function RegEnumKeyEx Lib "advapi32" Alias "RegEnumKeyExA" _
    (ByVal hKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpName As String, _
    lpcbName As Long, _
    ByVal lpReserved As Long, _
    ByVal lpClass As String, _
    lpcbClass As Long, _
    lpftLastWriteTime As FILETIME) As Long
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
    ByVal hKey As Long, _
    ByVal pSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long
    
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal hKey As Long) As Long
    
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    ByVal lpData As String, _
    lpcbData As Long) As Long
    
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, lpData As Long, _
    lpcbData As Long) As Long
    
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, ByVal lpData As Long, _
    lpcbData As Long) As Long
 
Private Sub GetAssociatedFileListing()
    Dim dwIndex As Long
    Dim sTypeName As String
    Dim sSubkey As String * MAX_PATH
    Dim sClass As String * MAX_PATH
    Dim ft As FILETIME
    Dim lSubkey As Long
    Dim hKey As Long
    
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Autodesk\AutoCAD", 0, KEY_READ, hKey) <> ERROR_SUCCESS Then Exit Sub
    
    lSubkey = MAX_PATH
    Do While RegEnumKeyEx(hKey, _
                          dwIndex, _
                          sSubkey, _
                          lSubkey, _
                          0, sClass, _
                          MAX_PATH, ft) = ERROR_SUCCESS
        Debug.Print Left(sSubkey, lSubkey)
        lSubkey = MAX_PATH
        dwIndex = dwIndex + 1
    Loop
End Sub

'Возвращает значения записанные в ключе(т.е. чтение)
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
    Dim lRetVal As Long
    Dim hKey As Long
    Dim vValue As Variant
 
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    QueryValue = vValue
    RegCloseKey (hKey)
End Function
 
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
 
    On Error GoTo QueryValueExError
 
    'Определение размера и типа считываемых данных
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then MsgBox "Данных (ключа) не существует!", vbExclamation, ""
    Select Case lType
        'Для символьных
    Case REG_SZ:
        sValue = String(cch, 0)
        lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
        If lrc = ERROR_NONE Then
            vValue = Left$(sValue, cch)
        Else
            vValue = Empty
        End If
        'Для числовых
    Case REG_DWORD:
        lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
        If lrc = ERROR_NONE Then vValue = lValue
        'Для остальных не поддержанных типов данных
    Case Else
        lrc = -1
    End Select
QueryValueExExit:
    QueryValueEx = lrc
    Exit Function
QueryValueExError:
    Resume QueryValueExExit
End Function

Sub test2()
    Call GetAssociatedFileListing
    
    Dim tmp
    tmp = QueryValue(HKEY_LOCAL_MACHINE, "\SOFTWARE\Autodesk\AutoCAD", "")
End Sub