如何快速得到电脑里面安装的所有的autocad的安装路径？

Question

如何快速得到电脑里面安装的所有的autocad的安装路径？（只要安装路径例如：\Program files\autocad R14就行），不要让我去搜索电脑里面所有的文件找

Answer 1

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByVal lpType As Long, ByVal lpData As String, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.    '从系统注册表中读取AutoCAD路径注册信息   i = RegOpenKey(HKEY_CLASSES_ROOT, cadver, RegResult)
   If i <> 0 Then
        cadpath = ""
   Else
       i = RegQueryValueEx(RegResult, "", 0, RegClass, Regpath, Len(Regpath))
       If i <> 0 Then
           cadpath = ""
        Else
            cadpath = Mid(Trim(Regpath), InStr(Trim(Regpath), Chr(34)) + 1)
            cadpath = Left(cadpath, IIf(InStr(cadpath, Chr(34)) > 0, InStr(cadpath, Chr(34)) - 1, Len(cadpath)))
        End If
    End If
End If

Answer 2

也可以这样找：
Const MAX_FILENAME_LEN = 260
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As LongPrivate Sub Form_Click()
   Dim I As Integer, s2 As String
   dim AutoCADPath as String
   Const MyCADFile = "F:\temp2\try.CAD"   s2 = String(MAX_FILENAME_LEN, 32)
   I = FindExecutable(MyCADFile, vbNullString, s2)
   If I > 32 Then
      AutoCADPath=Left$(s2, InStr(s2, Chr$(0)) - 1)
      msgbox AutoCADPath '报告AutoCAD.exe程序的路径
      shell AutoCADPath '运行AutoCAD.exe
   Else
      MsgBox "没找到AutoCAD程序！"
   End If
End Sub

Answer 3

也可通过遍历“HKEY_CLASSES_ROOT\aspfile\shell\”下的所有“Command”键的默认键值得到。

Answer 4

怎样遍历HKEY_LOCAL_MACHINE\SOFTWARE\AUTODESK\AUTOCAD的所有子项的所有ACAD-*的子项，然后找到这个acadlocation的键值？谢谢

Answer 5

'从系统注册表中读取AutoCAD路径注册信息' R14
   cadver = "AutoCAD.Drawing.14\shell\open\command"' R2000 等 有对应的位置和键值    Regpath = Space(100)   i = RegOpenKey(HKEY_CLASSES_ROOT, cadver, RegResult)
   If i <> 0 Then
        cadpath = ""
   Else
       i = RegQueryValueEx(RegResult, "", 0, RegClass, Regpath, Len(Regpath))
       If i <> 0 Then
           cadpath = ""
        Else
            cadpath = Mid(Trim(Regpath), InStr(Trim(Regpath), Chr(34)) + 1)
            cadpath = Left(cadpath, IIf(InStr(cadpath, Chr(34)) > 0, InStr(cadpath, Chr(34)) - 1, Len(cadpath)))
        End If
    End If
End If