Question

VB新建一个command控件，如何判断是否安装了某个程序然后打开？

我想这样的：新建一个command控件，设置caption属性为“千千静听”。如果安装了千千静听，那么点击就打开千千静听。且安装路径未知。如果没有安装千千静听。那么弹出msgbox提示没有安装此程序。
这些代码怎么写？最好是简单点的。呵呵。我刚开始自学。
我开始是这样想的，可是不行：
Private Sub Command1_Click()
If Dir(App.Path & "\ttplayer.exe") <> "" Then
Shell App.Path & "\ttplayer.exe"
Else
Msgbox"没有安装千千静听"
End If
End Sub

Answer 1

检查是否安装一个软件有如下办法：

1、查找进程，如果发现指定目标当然说明已安装了
2、查找注册表相应项目及文件关联，如果发现指定目标说明已安装了
3、检查Documents And Settings中的一些信息,如果发现指定目标说明已安装了
4、最后实在无奈，遍历文件系统查找吧、、

以上就是一般的方法，应该没有捷径、、

Answer 2

这个有点难度，连路径都不知道，那只能扫描你的电脑了。
呵呵。这么做，是不是又有点QQ的霸权了呢？

Answer 3

Private Sub Command1_Click()
Dim WSHShell, ttplayPath
Set WSHShell = CreateObject("WScript.Shell")
On Error Resume Next
ttplayPath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\TTPlayer.exe\")
If Err Then
MsgBox "你没有安装千千静听"
Else
Shell ttplayPath, vbNormalFocus
End If
End Sub

Answer 4

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

Function exitproc(ByVal exefile As String) As Boolean
exitproc = False
Dim hSnapShot As Long, uProcess As PROCESSENTRY32
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
If Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) = exefile Then
exitproc = True
Exit Do
End If
r = Process32Next(hSnapShot, uProcess)
Loop
End Function

窗体直接调用
示例如下：

Private Sub Command1_Click()
If exitproc("QQ.exe") Then '检测QQ.exe进程是否存在
MsgBox "存在！"
Else
MsgBox "不存在！"
End If
End Sub