判断是否安装ＱＱ，两种方法

 

一、API版：
'**************************************************************************
'**模 块 名：工程1 - Form1
'**说 明：永远的魔灵 by icecept(郭卫）
'**创 建 人：icecept(魔灵)
'**日 期：2009-11-15 20:27:03
'**修 改 人：icecept(魔灵)
'**版 本：V1.0.0
'**E-mail   ：icecept@163.com QQ：543375508
'**网 址：http://hi.baidu.com/icecept http://icecept.jimdo.com
'*************************************************************************
Option Explicit
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private 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
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOW = 5   '正常窗口
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Sub Command1_Click()
Dim hKey As Long
Dim Name As String * 255, intname1 As Integer
Dim lngTypeData As Long   '返回注册表值的数据类型
If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE/Tencent/QQ", hKey) = 0& Then
       RegQueryValueEx hKey, "Install", 0&, lngTypeData, ByVal Name, Len(Name)
       intname1 = InStr(Name, "QQ")
       If intname1 <> 0 Then
         ShellExecute Me.hwnd, "open", "tencent://message/?uin=543375508&Site=永远的魔灵<icecept>&Menu=yes", vbNullString, vbNullString, SW_SHOW
       End If
Else
       MsgBox "你没有安装QQ，请先安装QQ", vbOKOnly Or vbInformation, Me.Caption
End If
End Sub

二、WSH版
'**************************************************************************
'**模 块 名：工程1 - Form1
'**说 明：永远的魔灵 by icecept(郭卫）
'**创 建 人：icecept(魔灵)
'**日 期：2009-11-15 20:28:34
'**修 改 人：icecept(魔灵)
'**版 本：V1.0.0
'**E-mail   ：icecept@163.com QQ：543375508
'**网 址：http://hi.baidu.com/icecept http://icecept.jimdo.com
'*************************************************************************
Option Explicit
'需要首先在引用对话框中加载Windows Script Host Object Modle
Dim iw1 As New WshShell   '访问注册表等操作
'调用外部程序。而且还要暂停VB程序的执行,等待外部程序执行完毕后,在继续执行VB程序
'如果不需要等待，将Run语句中的第三个参数从True改为False就可以了。
Private Sub command1_Click()
On Error Resume Next
If getQQpath = "" Then
       MsgBox "你没有安装QQ，请先安装QQ", vbOKOnly Or vbInformation, Me.Caption
Else
       iw1.Run "tencent://message/?uin=543375508&Site=永远的魔灵<icecept>&Menu=yes"
End If
End Sub
'判断是否安装QQ
Private Function getQQpath() As String
getQQpath = iw1.RegRead("HKEY_LOCAL_MACHINE/SOFTWARE/Tencent/QQ/Install")
End Function