申请ID：小歆[申请通过]

ps：刚刚发过一个贴，可是出现“单表提交错误”，不知成没成功所以再发一遍...
1、申 请 I D ：小歆
2、个人邮箱：zhangzejin3883@163.com
3、自我简单介绍及主要作品链接：                        本人是学电子的在校大学生，爱好VB，C，脚本等，现在还在学一些单片机和汇编的知识；这几天用VB写了个挂QQ的工具，贴出来交流一下啊！
4、申请时间：2012年6月20日
5、备注：请管理人员审核，谢谢！
6、作品：
command四个1，2，4，5
text六个，label六个（一一对应）
定时器两个timer1（开启，200毫秒）和QQtime（开启，60000毫秒）

源码如下：
（说明一下SID的获取，要通过wap登陆QQ后，查看地址即可看到“sid=....&”把“=”和“&”直接的代码粘贴到文本框里就OK啦！）

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Long '热键声明
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '延时声明

Dim qt, int_End  As Integer

Private Sub Command1_Click()
    Dim msg1 As Integer
    If QQtime.Enabled = False Then
        QQtime.Enabled = True
        Command1.Caption = "停止挂机"
        Text1.Enabled = False
        Text2.Enabled = False
        Text3.Enabled = False
        Text4.Enabled = False
        Text5.Enabled = False
        Text6.Enabled = False
        Command3.Enabled = False
        QQgj
    Else
        msg1 = MsgBox("注：停止挂机后30分钟内被挂机QQ将下线！", vbInformation, "提示")
        QQtime.Enabled = False
        Command1.Caption = "开始挂机"
        Text1.Enabled = True
        Text2.Enabled = True
        Text3.Enabled = True
        Text4.Enabled = True
        Text5.Enabled = True
        Text6.Enabled = True
        Command3.Enabled = True
    End If
End Sub

Private Sub Command2_Click()
    SendKeys vbTab '解决按钮出现虚线框
    Dim int_Exit   As Integer
    int_Exit = MsgBox("您是要隐藏工具窗体？ ", vbYesNo, "提示 ")
    If int_Exit = vbYes Then
        Me.Visible = Not Me.Visible '窗体可见不可见
        Cancel = -1 '   取消退出操作
    Else
        int_End = MsgBox("您确定要退出挂机工具吗？如果退出将停止一切挂机活动！ ", vbYesNo, "提示 ")
        If int_End = vbYes Then
            Set Form1 = Nothing
            End
        Else
            Cancel = -1 '   取消退出操作
        End If
    End If
End Sub

Private Sub Command4_Click()
If Command6.Top < 3600 Then             '高度差480
    Command4.Top = Command4.Top + 480
    Command5.Top = Command5.Top + 480
    Command6.Top = Command6.Top + 480
    Me.Height = Me.Height + 480
    If Command6.Top = 1680 Then
        Label2.Visible = True
        Text2.Visible = True
    ElseIf Command6.Top = 2160 Then
        Label3.Visible = True
        Text3.Visible = True
    ElseIf Command6.Top = 2640 Then
        Label4.Visible = True
        Text4.Visible = True
    ElseIf Command6.Top = 3120 Then
        Label5.Visible = True
        Text5.Visible = True
    ElseIf Command6.Top = 3600 Then
        Label6.Visible = True
        Text6.Visible = True
        Command4.Enabled = False
    End If
End If
Command5.Enabled = True
SendKeys vbTab '解决按钮出现虚线框
End Sub

Private Sub Command5_Click()
If Command6.Top > 1200 Then            '高度差480
    Command4.Top = Command4.Top - 480
    Command5.Top = Command5.Top - 480
    Command6.Top = Command6.Top - 480
    Me.Height = Me.Height - 480
    If Command6.Top = 1200 Then
        Label2.Visible = False
        Text2.Visible = False
        Command5.Enabled = False
    ElseIf Command6.Top = 1680 Then
        Label3.Visible = False
        Text3.Visible = False
    ElseIf Command6.Top = 2160 Then
        Label4.Visible = False
        Text4.Visible = False
    ElseIf Command6.Top = 2640 Then
        Label5.Visible = False
        Text5.Visible = False
    ElseIf Command6.Top = 3120 Then
        Label6.Visible = False
        Text6.Visible = False
    End If
End If
Command4.Enabled = True
SendKeys vbTab '解决按钮出现虚线框
End Sub

Private Sub Form_Load()
    If App.PrevInstance = True Then
        SendKeys vbKeyEscape
        End
    End If
    
    Command4.Top = 1200
    Command5.Top = 1200
    Command6.Top = 1200
    Me.Height = 2055
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Me.Visible = Not Me.Visible '窗体可见不可见
    Cancel = -1 
End Sub

Private Sub Form_Unload(Cancel As Integer)
      Set Form1 = Nothing
      End
End Sub

Private Sub QQtime_Timer()
    Dim i As Integer
    If qt = 0 Then
        QQgj
    End If
    qt = qt + 1
    If qt = 20 Then qt = 0
End Sub

Private Sub Timer1_Timer()
      '检查是否热键被按下
    If GetAsyncKeyState(vbKeyEscape) Then Me.Visible = Not Me.Visible '按下 ESC 键让窗体可见或不可见
    If GetAsyncKeyState(vbKeyEnd) Then '按下END 退出程序
        int_End = MsgBox("您确定要退出挂机工具吗？如果退出将停止一切挂机活动！ ", vbYesNo, "提示 ")
        If int_End = vbYes Then
            Set Form1 = Nothing
            End
        Else
            Cancel = -1
        End If
    End If
End Sub

Public Function QQgj()
        For i = 0 To 5
            If i = 0 Then
                sid = Text1.Text
            ElseIf i = 1 Then
                sid = Text2.Text
                Sleep 5000
            ElseIf i = 2 Then
                sid = Text3.Text
                Sleep 5000
            ElseIf i = 3 Then
                sid = Text4.Text
                Sleep 5000
            ElseIf i = 4 Then
                sid = Text5.Text
                Sleep 5000
            ElseIf i = 5 Then
                sid = Text6.Text
                Sleep 5000
            End If
            If sid = "" Then
                Exit For
            End If
            With CreateObject("Msxml2.ServerXMLHTTP")
                .open "POST", "http://pt.3g.qq.com/s?aid=nLogin3gqqbysid&r=" & Rnd, False
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                .send "auto=1&loginType=1&3gqqsid=" & sid
            End With
        Next i
End Function

本人菜鸟一个写的不是很好，大牛们见笑啦~~~

Hmily

ID:小歆
邮箱:zhangzejin3883@163.com

申请通过,欢迎光临吾爱破解论坛,期待吾爱破解有你更加精彩,ID和密码自己通过邮件密码找回功能修改,请即时登陆并修改密码!
登陆后请在一周内在此帖报道，否则将删除ID信息

小歆

小歆过来报道啦，谢谢管理员啊~