suparc平台97rom下载:在VB中如何实现相对路径调用CAD应用程序~~~~

来源:百度文库 编辑:高考问答 时间:2024/05/10 12:59:02
在VB中~~我在VB中~~我想调用ATOUCAD的应用程序打开DWG格式的文件~
我使用
Shell "D:\program files\AutoCAD 2004\acad.exe", vbNormalFocus
完成操作~可这是一个绝对路径,在别的机上或没安装CAD的机上就会提示出错,我想问下有没有办法,像关联WINDOWS自带的浏览器一样~通过修改注册表或是其它方法达到相对的调用CAD应用程序呢?
同时,调用CAD应用程序时能打开文件路径显示在text1.text控件中的文件.
我用
Shell "D:\program files\AutoCAD 2004\acad.exe,text1.text", vbNormalFocus 提示找不到路径`出错~可能我格式不对~但我想应该可以实现的~有朋友帮忙我这两个问题吗?谢谢了~分不分~却是我的全部.
我希望有比较完整的程序.没办法~我比较菜~~555555
注:(如果使用修改注册表而你的机上没安装CAD的话你可以给我个模式,让我自己填入那条注册表信息,并告诉我如何找到那条注册表信息~这个我不懂啦~)全部的分奉上~
大哥~太专业了,我都不知如何引用到VB中去~~有比较详细的模式吗?这些非VB代码~一头雾水!

把以下这些加在VB的BAS中,然后调用ACADRun这个函数就可以了。

Option Explicit

'Reg Main Item
Public Const HKEY_CLASSES_ROOT& = &H80000000
Public Const HKEY_CURRENT_USER& = &H80000001
Public Const HKEY_LOCAL_MACHINE& = &H80000002
Public Const HKEY_USERS& = &H80000003
Public Const HKEY_PERFORMANCE_DATA& = &H80000004
Public Const HKEY_CURRENT_CONFIG& = &H80000005
Public Const HKEY_DYN_DATA& = &H80000006

'Peg Type
Public Const REG_NONE = 0 'No value type
Public Const REG_SZ = 1 'Unicode nul terminated string
Public Const REG_EXPAND_SZ = 2 'Unicode nul terminated string
Public Const REG_BINARY = 3 'Free form binary
Public Const REG_DWORD = 4 '32-bit number

'Open Reg Key
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long

'QueryValue In Reg
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long

'Close Reg
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'****************************************************************
' This Function Create For Run ACAD
'****************************************************************
Public Sub ACADRun()
Dim sPath$

'This Function Get Path Of ACAD
sPath = ACADPathGet()

'Check Path Exist
If Trim$(sPath) = "" Then
Exit Sub
End If

'Run ACad
Shell Trim$(sPath), vbNormalFocus
End Sub

'****************************************************************
' This Function Get Path Of ACAD
'****************************************************************
Public Function ACADPathGet()
Dim sPath$, sKey$
Dim sValue As String, sUseValue$, lLength&, lType&
Dim KeyCADFile&, KeyACad&, KeyCLSID&, KeyItem1&, KeyItem2&

ACADPathGet = ""

'Open Classes Root (AutoCAD.Application)
sKey = ".dwg"
If RegOpenKey(HKEY_CLASSES_ROOT, sKey, KeyCADFile) = 0 Then
'Length
lLength = 100
lType = REG_SZ
sValue = String(lLength, Chr$(0))
If RegQueryValueEx(KeyCADFile, vbNullString, 0, lType, ByVal sValue, lLength) = 0 Then
sUseValue = Left$(sValue, InStr(sValue, Chr$(0)) - 1)
End If

'Close Key ACad File
Call RegCloseKey(KeyCADFile)
End If

'Open Classes Root (AutoCAD.Application)
sKey = sUseValue
If RegOpenKey(HKEY_CLASSES_ROOT, sKey, KeyACad) = 0 Then

'Open Key CLSID Of AutoCAD.Application
sKey = "CLSID"
If RegOpenKey(KeyACad, sKey, KeyCLSID) = 0 Then
'Length
lLength = 100
lType = REG_SZ
sValue = String(lLength, Chr$(0))
If RegQueryValueEx(KeyCLSID, vbNullString, 0, lType, ByVal sValue, lLength) = 0 Then
sUseValue = Left$(sValue, InStr(sValue, Chr$(0)) - 1)
End If

'Close Key CLSID
Call RegCloseKey(KeyCLSID)
End If

'Close Key ACad
Call RegCloseKey(KeyACad)
End If

'Open Classes Root (CLSID)
sKey = "CLSID"
If RegOpenKey(HKEY_CLASSES_ROOT, sKey, KeyCLSID) = 0 Then

'Open Key ACAD CLSID Of CLSID
sKey = Trim$(UCase(sUseValue))
If RegOpenKey(KeyCLSID, sKey, KeyItem1) = 0 Then

'Open Key ACAD CLSID Of CLSID
sKey = "LocalServer32"
If RegOpenKey(KeyItem1, sKey, KeyItem2) = 0 Then

'Length
lLength = 255
sValue = String(lLength, Chr$(0))
If RegQueryValueEx(KeyItem2, vbNullString, 0, lType, ByVal sValue, lLength) = 0 Then
ACADPathGet = Left$(sValue, InStr(sValue, Chr$(0)) - 1)
End If

'Close Key Item 2
Call RegCloseKey(KeyItem2)
End If

'Close Key Item 1
Call RegCloseKey(KeyItem1)
End If

'Close Key CLSID
Call RegCloseKey(KeyCLSID)
End If
End Function
--------------------------------------------------------------

在注册表项 HKEY_CLASSES_ROOT 中找到 AutoCAD.Application 项
在 AutoCAD.Application 项中找到 CLSID 的值
然后在注册表项 HKEY_CLASSES_ROOT 中找到 CLSID 项
根据上面找到的CLSID 的值,再找出 LocalServer32 项
LocalServer32 中包含了 AutoCad 执行文件 acad.exe 的路径
--------------------------------------------------------------
以下是取注册表信息的API函数
1。打开主项
LONG RegOpenKey(
HKEY hKey, //
LPCTSTR lpSubKey, // name of subkey to open
PHKEY phkResult // handle to open key
);
(HKEY_CLASSES_ROOT = 0x80000000)

2。查询注册表并取得注册表的值
LONG RegQueryValueEx(
HKEY hKey, // handle to key
LPCTSTR lpValueName, // value name
LPDWORD lpReserved, // reserved
LPDWORD lpType, // type buffer
LPBYTE lpData, // data buffer
LPDWORD lpcbData // size of data buffer
);

3。关闭注册表项
RegCloseKey(HKEY hKey);

用VB声明一下