如何判断CAD是否正在运行？？？？？？？？？？？

挚友01

我在EXCEL用VBA加入了一段判断CAD是否正在运行的程序:
On Error Resume Next
            Set acadApp = GetObject(, "AutoCAD.Application")
            If acadApp Is Nothing Then
                MsgBox "Çë′ò¿aAutoCAD¡￡"
                    Else

大部分机器都没问题，32位或64位，可有的机器监测不到CAD是否在运行，估计是系统进程的事，大家帮着分析一下有可能什么地方出现了问题？如何解决？
我在EXCEL论坛发表这类问题，都说上面的方法没问题，可在实际装机器时就出现了无法监测CAD

marting

检测不到CAD到时候，CAD是什么版本呢？

是否有同样的安装版本的CAD，有的机器认有的不认呢？

挚友01

都是2006的，部分装了2010,在这两类机器上都有少量出现...

st788796

2. 
   
3. Sub 所有进程()
   
4. Set objs = GetObject("WinMgmts:").InstancesOf("Win32_Process")
   
5. For Each Obj In objs
   
6. tmp = tmp & WorksheetFunction.Text(a + 1, "[DBNum2][$-804]0:  ") + vbTab + Obj.Description + Chr(13)
   
7. a = a + 1
   
8. Next
   
9. MsgBox tmp, 65, "提醒："
   
10. End Sub
    

<br /> Sub 所有进程()<br /> Set objs = GetObject("WinMgmts:").InstancesOf("Win32_Process")<br /> For Each Obj In objs<br /> tmp = tmp & WorksheetFunction.Text(a + 1, "[DBNum2][$-804]0:  ") + vbTab + Obj.Description + Chr(13)<br /> a = a + 1<br /> Next<br /> MsgBox tmp, 65, "提醒："<br /> End Sub<br />

2. 
   
3. Option Explicit
   
4. 
   
5. Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
   
6. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
7. Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
   
8. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
   
9. Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
   
10. Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
    
11. Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    
12. Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
    
13. Private Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    
14. 
    
15. '==========================================================
    
16. '通过进程名获得PID所用 上面声明过的这里暂且注释掉
    
17. '私有的CreateToolhelp32Snapshot
    
18. Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
    
19. Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
    
20. Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
    
21. '私有的TerminateProcess
    
22. Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    
23. 'Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    
24. 'Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
    
25. Private Const TH32CS_SNAPPROCESS = &H2&
    
26. 
    
27. Private Type PROCESSENTRY32
    
28.     dwSize As Long
    
29.     cntUsage As Long
    
30.     th32ProcessID As Long
    
31.     th32DefaultHeapID As Long
    
32.     th32ModuleID As Long
    
33.     cntThreads As Long
    
34.     th32ParentProcessID As Long
    
35.     pcPriClassBase As Long
    
36.     dwFlags As Long
    
37.     szExeFile As String * 260
    
38. End Type
    
39. Const PROCESS_TERMINATE = 1
    
40. 
    
41. '==============================================================
    
42. '通过进程PID获取应用程序的完整路径
    
43. Public Function GetProcessPathByProcessID(pid As Long) As String
    
44.     On Error GoTo ErrLine
    
45.     Dim cbNeeded As Long
    
46.     Dim szBuf(1 To 250) As Long
    
47.     Dim Ret As Long
    
48.     Dim szPathName As String
    
49.     Dim nSize As Long
    
50.     Dim hProcess As Long
    
51.     hProcess = OpenProcess(&H400 Or &H10, 0, pid)
    
52.     If hProcess <> 0 Then
    
53.        Ret = EnumProcessModules(hProcess, szBuf(1), 250, cbNeeded)
    
54.        If Ret <> 0 Then
    
55.          szPathName = Space(260)
    
56.          nSize = 500
    
57.          Ret = GetModuleFileNameExA(hProcess, szBuf(1), szPathName, nSize)
    
58.          GetProcessPathByProcessID = Left(szPathName, Ret)
    
59.        End If
    
60.     End If
    
61.     Ret = CloseHandle(hProcess)
    
62.     If GetProcessPathByProcessID = "" Then
    
63.        GetProcessPathByProcessID = "SYSTEM"
    
64.     End If
    
65. ErrLine:
    
66. End Function
    
67. 
    
68. 
    
69. '通过进程名获得进程PID
    
70. Public Function GetProcessPID(sProcess As String) As Long
    
71.     Dim lSnapShot As Long
    
72.     Dim lNextProcess As Long
    
73.     Dim tPE As PROCESSENTRY32
    
74.     Dim lProcess As Long
    
75.     Dim lExitCode As Long
    
76.     lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    
77.     If lSnapShot <> -1 Then
    
78.         tPE.dwSize = Len(tPE)
    
79.         lNextProcess = Process32First(lSnapShot, tPE)
    
80.         Do While lNextProcess
    
81.             If LCase$(sProcess) = LCase$(Left(tPE.szExeFile, InStr(1, tPE.szExeFile, Chr(0)) - 1)) Then
    
82.                 'Dim lProcess As Long
    
83.                 'Dim lExitCode As Long
    
84.                 GetProcessPID = tPE.th32ProcessID
    
85.                 CloseHandle lProcess
    
86.             End If
    
87.             lNextProcess = Process32Next(lSnapShot, tPE)
    
88.         Loop
    
89.         CloseHandle (lSnapShot)
    
90.     End If
    
91. End Function
    
92. 
    
93. '通过进程名获得应用程序的路径(通过上面两个函数)
    
94. Public Function GetProcessPath(sProcess As String) As String
    
95.     Dim aa As Long
    
96.     aa = GetProcessPID(sProcess)
    
97.     GetProcessPath = GetProcessPathByProcessID(aa)
    
98. End Function

<br /> Option Explicit<br /> <br /> Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long<br /> Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long<br /> Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long<br /> Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long<br /> Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long<br /> Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long<br /> Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long<br /> Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long<br /> Private Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)<br /> <br /> '==========================================================<br /> '通过进程名获得PID所用 上面声明过的这里暂且注释掉<br /> '私有的CreateToolhelp32Snapshot<br /> Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long<br /> Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long<br /> Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long<br /> '私有的TerminateProcess<br /> Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long<br /> 'Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long<br /> 'Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)<br /> Private Const TH32CS_SNAPPROCESS = &H2&<br /> <br /> Private Type PROCESSENTRY32<br />     dwSize As Long<br />     cntUsage As Long<br />     th32ProcessID As Long<br />     th32DefaultHeapID As Long<br />     th32ModuleID As Long<br />     cntThreads As Long<br />     th32ParentProcessID As Long<br />     pcPriClassBase As Long<br />     dwFlags As Long<br />     szExeFile As String * 260<br /> End Type<br /> Const PROCESS_TERMINATE = 1<br /> <br /> '==============================================================<br /> '通过进程PID获取应用程序的完整路径<br /> Public Function GetProcessPathByProcessID(pid As Long) As String<br />     On Error GoTo ErrLine<br />     Dim cbNeeded As Long<br />     Dim szBuf(1 To 250) As Long<br />     Dim Ret As Long<br />     Dim szPathName As String<br />     Dim nSize As Long<br />     Dim hProcess As Long<br />     hProcess = OpenProcess(&H400 Or &H10, 0, pid)<br />     If hProcess <> 0 Then<br />        Ret = EnumProcessModules(hProcess, szBuf(1), 250, cbNeeded)<br />        If Ret <> 0 Then<br />          szPathName = Space(260)<br />          nSize = 500<br />          Ret = GetModuleFileNameExA(hProcess, szBuf(1), szPathName, nSize)<br />          GetProcessPathByProcessID = Left(szPathName, Ret)<br />        End If<br />     End If<br />     Ret = CloseHandle(hProcess)<br />     If GetProcessPathByProcessID = "" Then<br />        GetProcessPathByProcessID = "SYSTEM"<br />     End If<br /> ErrLine:<br /> End Function<br /> <br /> <br /> '通过进程名获得进程PID<br /> Public Function GetProcessPID(sProcess As String) As Long<br />     Dim lSnapShot As Long<br />     Dim lNextProcess As Long<br />     Dim tPE As PROCESSENTRY32<br />     Dim lProcess As Long<br />     Dim lExitCode As Long<br />     lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)<br />     If lSnapShot <> -1 Then<br />         tPE.dwSize = Len(tPE)<br />         lNextProcess = Process32First(lSnapShot, tPE)<br />         Do While lNextProcess<br />             If LCase$(sProcess) = LCase$(Left(tPE.szExeFile, InStr(1, tPE.szExeFile, Chr(0)) - 1)) Then<br />                 'Dim lProcess As Long<br />                 'Dim lExitCode As Long<br />                 GetProcessPID = tPE.th32ProcessID<br />                 CloseHandle lProcess<br />             End If<br />             lNextProcess = Process32Next(lSnapShot, tPE)<br />         Loop<br />         CloseHandle (lSnapShot)<br />     End If<br /> End Function<br /> <br /> '通过进程名获得应用程序的路径(通过上面两个函数)<br /> Public Function GetProcessPath(sProcess As String) As String<br />     Dim aa As Long<br />     aa = GetProcessPID(sProcess)<br />     GetProcessPath = GetProcessPathByProcessID(aa)<br /> End Function

Lisphk

st788796 发表于 2017-3-21 17:24

大师，能转成VLISP代码吗？

kqqt6236

正需要，支持楼主大人了！

st788796

Lisphk 发表于 2017-3-21 18:04

说的是在 Excel 运行的 VBA ，改在 AutoCAD 下有什么意义？

Lisphk

st788796 发表于 2017-3-22 08:35

我看到里面的获得进程名，进程路径什么的，不是挺有用的嘛

st788796

Lisphk 发表于 2017-3-22 08:45

Windows 10 64bit 管理员权限测试 OK

xinxirong

关键是GetObject(, "AutoCAD.Application")不能根据Pid选择进程，CreateObject也不行。

sicky111

st788796大师可以把代码贴上来吗