Option Explicit
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
Dim qq As Long, qqzai As String, qqli As String
Private Sub Command1_Click()
qq = CLng(Text1.Text) '从文本框中获取要查询的号码
If Len(Text1) < 5 Or qq = 0 Then '限制QQ号码最少位数
MsgBox "请输入QQ号码!!!", , "提示"
Text1.SetFocus '使text1获得焦点
Text1.Text = ""
Exit Sub '结束过程
Else
Web.Navigate " http://wpa.qq.com/pa?p=1:" & qq & ":1
'通过Navigate方法连接所指顶的网址,注& qq &之间相隔两个空格符
End If
End Sub
Private Sub Command3_Click()
Unload Me
End
End Sub
Private Sub Command2_Click()
Dim UrL As String
UrL = "tencent://Message/?Uin=" & Text1.Text & "&websiteName=Sweek.com&Menu=yes"
ShellExecute Me.hwnd, "open", UrL, "", App.Path, SW_SHOW
End Sub
Private Sub Form_Load()
Me.Show
Image1.Visible = False
Image2.Visible = False
Command2.Enabled = False
Text1.SetFocus
Text1.SelLength = Len(Text1.Text) '将文本框的内容全部选择
Web.Visible = False
End Sub
Private Sub Text1_Click()
Text1.Text = ""
Image1.Visible = False '重新查询时QQ状态图标隐藏
Image2.Visible = False
Form1.Caption = "QQ查询状态"
Command2.Enabled = False
End Sub
Private Sub Web_TitleChange(ByVal Text As String)
qqzai = " http://wpslogo.qq.com/qq_online.gif" 'QQ在线状态的地址
qqli = " http://wpslogo.qq.com/qq_offline.gif" 'QQ离线状态的地址
If Web.LocationURL = qqzai Then
'如果地址返回的是QQ在线状态的地址,那么执行下面的语句
'LocationURL返回WebBrowser当前正在显示的资源的URL ,
'也就是已经工作完成后的URL
Image1.Visible = True '显示QQ在线状态亮图标
Image2.Visible = False
Form1.Caption = "该QQ目前在线"
Command2.Enabled = True
ElseIf Web.LocationURL = qqli Then
'如果返回的是QQ离线状态的地址,那么QQ离线的图标被显示出来
Image2.Visible = True
Image1.Visible = False
Form1.Caption = "该QQ目前不在线"
Command2.Enabled = False
End If
End Sub
这是显示是否在线的代码 有没有可以查是否隐身的 麻烦点没关系 谁教教我啊
加我QQ也行 599106869