---

Wiess jemand unter welcher Variable in Windows der Installationspfad von AutoCad abgespeichert ist?

(So wie z.B. %ProgramFiles% für c:\Programme\ steht)

Gruss
Markus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Über die Registry, unter dem Schlüssel

HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R15.0\ACAD-1:407

gibt es eine Zeichenfolge AcadLocation, dort steht der Pfad,

Der letzte Eintrag (ACAD-1:407) kann variieren, aber unter

HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R15.0

Zeichenfolge CurVer steht er.

Das Auslesen in VBA kann folgendermaßen aussehen:

Public Sub ReadAcadPath()

strCurver = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Autodesk\AutoCAD\R15.0", "CurVer")

If strCurver = "" Then
    MsgBox "Keine installierte AutoCAD2000/2000i/2002 - Version gefunden.", vbCritical, "Cad&Co_Modular"
Exit Sub
Else
    On Error Resume Next
    strCurver = Left(strCurver, Len(strCurver) - 1)
    strAcadnu = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Autodesk\AutoCAD\R15.0\" & strCurver, "SerialNumber")
    strAcadnu = Left(strAcadnu, Len(strAcadnu) - 1)
    strAPath = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Autodesk\AutoCAD\R15.0\" & strCurver, "AcadLocation")
    strAPath = Left(strAPath, Len(strAPath) - 1)
    If Err.Number <> 0 Then
      MsgBox "Keine installierte AutoCAD2000/2000i/2002 - Version gefunden.", vbCritical, "Cad&Co_Modular"
      Exit Sub
    End If
  End If

End Sub

'Funktionen zum Auslesen der Registry

Option Explicit

Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const ERROR_SUCCESS = 0&

Global Const KEY_ALL_ACCESS = &H3F
Global Const KEY_READ = &H20019

Global Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
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
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
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
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Function RegKeyExist(lPredefinedKey As Long, sKeyName As String) As Long

  Dim lRetVal As Long
  Dim hKey As Long
 
  lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_READ, hKey)
 
  RegKeyExist = lRetVal
 
End Function

Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)

  Dim lRetVal As Long
 
  lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)

End Function

Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
 
  Dim hNewKey As Long
  Dim lRetVal As Long
   
  lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, _
                          REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
           
  RegCloseKey (hNewKey)
 
End Function

Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, _
                            vValueSetting As Variant, lValueType As Long)
 
  Dim lRetVal As Long
  Dim hKey As Long
 
  lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
  RegCloseKey (hKey)

End Function

Public Function GetKeyValue(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_READ, hKey)
  lRetVal = QueryValueEx(hKey, sValueName, vValue)
  GetKeyValue = vValue
  RegCloseKey (hKey)
     
End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

  Dim lValue As Long
  Dim sValue As String

  Select Case lType
    Case REG_SZ
      sValue = vValue
      SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
    Case REG_DWORD
      lValue = vValue
      SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
    End Select
   
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 Error 5

  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

------------------
Ing. Bernd Cuder
Cad&Co makes CAD easy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP