📄 form1.frm
字号:
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "fm20.dll"
Begin VB.Form Form1
BackColor = &H00C0FFC0&
BorderStyle = 1 'Fixed Single
Caption = "QQ在线查询 作者:281875721"
ClientHeight = 1965
ClientLeft = 7395
ClientTop = 4620
ClientWidth = 3720
ForeColor = &H00C0FFC0&
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1965
ScaleWidth = 3720
ShowInTaskbar = 0 'False
Begin VB.Timer Timer1
Interval = 1000
Left = 2280
Top = 840
End
Begin SHDocVwCtl.WebBrowser WebBrowser2
Height = 375
Left = 3600
TabIndex = 2
Top = 2520
Visible = 0 'False
Width = 255
ExtentX = 450
ExtentY = 661
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End
Begin SHDocVwCtl.WebBrowser WebBrowser1
Height = 1575
Left = -240
TabIndex = 1
Top = 3120
Visible = 0 'False
Width = 3255
ExtentX = 5741
ExtentY = 2778
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End
Begin VB.TextBox Text1
Height = 375
Left = 480
MaxLength = 10
TabIndex = 0
Text = "281875721"
Top = 360
Width = 1095
End
Begin MSForms.Label Label1
Height = 375
Left = 240
TabIndex = 8
Top = 1680
Width = 3615
ForeColor = -2147483640
BackColor = 12648384
VariousPropertyBits= 8388627
Size = "6376;661"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.CommandButton Command2
Height = 375
Left = 2760
TabIndex = 7
Top = 360
Width = 855
VariousPropertyBits= 19
Caption = "聊天"
Size = "1508;661"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton Command1
Height = 375
Left = 1800
TabIndex = 6
Top = 360
Width = 855
BackColor = 12648384
VariousPropertyBits= 19
Caption = "QQ在线"
Size = "1508;661"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.Label Label2
Height = 255
Left = 120
TabIndex = 5
Top = 480
Width = 495
ForeColor = -2147483640
BackColor = 12648384
VariousPropertyBits= 8388627
Caption = "QQ:"
Size = "873;450"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.OptionButton Option2
Height = 375
Left = 840
TabIndex = 4
Top = 960
Width = 855
VariousPropertyBits= 746588179
BackColor = 12648384
DisplayStyle = 5
Size = "1508;661"
Value = "0"
Caption = "离线"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.OptionButton Option1
Height = 375
Left = 120
TabIndex = 3
Top = 960
Width = 855
VariousPropertyBits= 746588179
BackColor = 12648384
ForeColor = -2147483641
DisplayStyle = 5
Size = "1508;661"
Value = "0"
Caption = "在线"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
'Code to make the Form Transparent:
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Sub Command1_Click()
Dim URL
URL = "http://wpa.qq.com/pa?p=1:" & Text1.Text & ":8"
WebBrowser1.Navigate URL
Option1.Value = False
Option2.Value = False
End Sub
Private Sub Command2_Click()
Shell "explorer " & Chr(34) & "tencent://Message/?Uin=" & Text1.Text & Chr(34)
End Sub
Private Sub Form_Load()
App.TaskVisible = False
Dim success%
success = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
Option1.Value = False
Option2.Value = False
Me.AutoRedraw = True
hBitmap = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, hBitmap
Me.Refresh
End Sub
Private Sub OptionButton1_Click()
End Sub
Private Sub Timer1_Timer()
Label1.Caption = Format(Now, "YYYY-MM-DD hh:mm:ss 作者：骷髅兵")
End Sub
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
Dim aaa As String
aaa = WebBrowser1.LocationName
Call pd(aaa)
End Sub
Sub pd(aaa)
Dim b As String, c As String
Dim d As Integer, e As Integer
d = e = 1
b = "http://wpslogo.qq.com/8_offline.gif"
c = "http://wpslogo.qq.com/8_online.gif"
If aaa = b Then Option2.Value = True Else: d = 0
If aaa = c Then Option1.Value = True Else: e = 0
End Sub
'________________________________________________________________________________________________________
'此代码完全正常运行!
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -