frmwebatk.frm

全面网络扫描器VB源代码 很实用

   
End Sub

Private Sub lstplug_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then Call lstplug_Click
 
End Sub

Private Sub lstplug_KeyUp(KeyCode As Integer, Shift As Integer)
   If KeyCode = 40 Or KeyCode = 38 Then
       Call lstplug_Click
  End If


End Sub

Private Sub mnunewscan_Click()
 frmnewscan.Show
End Sub

Private Sub mnuResponse_Click()
  frmatkreport.Show
End Sub

Private Sub Option1_Click(Index As Integer)
'   If Index = 3 And Option1(3).Value = True Then
'     txtportstart.Enabled = Not (txtportstart.Enabled)
'     txtportend.Enabled = Not (txtportend.Enabled)
'   Else
'      txtportstart.Enabled = False
'      txtportend.Enabled = False
'   End If
End Sub

Private Sub savemnu_Click()
cd1.ShowSave
 If cd1.FileName = "" Then
   MsgBox "PLEASE Enter A FileName ", vbInformation, "Err"
   Exit Sub
 Else
   c = FreeFile
   Open cd1.FileName + ".html" For Output As c
              'Print #1, createhtml
   Close c
 End If
 
 
End Sub



Private Sub txtendip_GotFocus(Index As Integer)
  SendKeys "{HOME}+{END}"
End Sub



Private Sub VScroll1_Change()
  txtdelay.Text = VScroll1.value
End Sub


  

Private Sub Winsock1_Close()
     'Write the response to a file
'***************    Call WriteLastResponseToFile
    
    'Update the status bar
   ' WriteLogEntry "Closing socket ...", 6
    
    'Disable the timer because a time out makes no sense anymore
   ' timTimeout.Enabled = False
    
    'Close and free the socket
    Winsock1.Close
    

    

End Sub


'Private Sub wsckClient_Error(Index As Integer, ByVal Number As Integer, _
'    Description As String, ByVal Scode As Long, ByVal Source As String, _
'    ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'    WriteLogEntry "WinSock Error: [" & Number & "] " & Description, 1



'End Sub

  
  
  
Private Sub cmdSend_Click()
sendstop = False
If lstplug.ListItems.Count < 1 Then MsgBox "Please Load plugins ", vbInformation, "Err": Exit Sub
 frmatkreport.ListView1.ListItems.Clear
 cmdSend.Enabled = False
' TreeView1.Nodes.Clear
'  Timer1.Enabled = True
ProgressBar1.value = 0
  
If Option1(0).value = True Then
       
 If lstplug.SelectedItem.Index Then
     txtplugshow.Text = ParseATKPlugin(readplug(lstplug.SelectedItem.Key))
     AttackProcedure
End If
  
Else
  'for 2 options
  
  If Option1(1).value = True Then da = 1
   ProgressBar1.Max = lstplug.ListItems.Count
   For J = 1 To lstplug.ListItems.Count
    If da = 1 And lstplug.ListItems.item(J).Checked = True Then
        txtplugshow.Text = ParseATKPlugin(readplug(lstplug.ListItems(J).Key))
        AttackProcedure
    End If
    If da = 0 And lstplug.ListItems.item(J).Checked = False Then
       txtplugshow.Text = ParseATKPlugin(readplug(lstplug.ListItems(J).Key))
        AttackProcedure
    End If
   ProgressBar1.value = ProgressBar1.value + 1
   If sendstop = True Then Exit For
   Next J



End If
 cmdSend.Enabled = True
 Call mnuResponse_Click
End Sub
Sub loadp(filepath As String, allp As Boolean)
 Dim file As String
 On Error GoTo err
  
  If filepath = "" Then: MsgBox "Please Enter A File Name", vbCritical, "TIP !": Exit Sub
 
 
  Dim SearchPath As String, FindStr As String
  Dim FileSize As Long
  Dim NumFiles As Integer, NumDirs As Integer

  'read (App.path + "\" + "ress.txt")
   SearchPath = filepath
   FindStr = "*.plugin"
   FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs, allp)
 
 
 
' Open filepath For Binary As #1
'   file = String(LOF(1), " ")
'   Get #1, 1, file
'        If Len(file) < 1 Then GoTo err
        
'   For j = 0 To l
        
'        f1 = InStr(1, file, "-,", vbTextCompare)
'        f2 = InStr(f + 1, file, "+,", vbTextCompare)
         
         
'         If f1 > f2 And f2 <> 0 Then
'             f = f2
'             fl = 1
'          Else
'             f = f1
'         End If
         
 
'           g2 = InStr(f + 1, file, ",,,", vbTextCompare)
'          saver = Mid(file, f + 2, g2 - f - 2)
'
'         lstports.ListItems.Add , , saver
'         If fl = 1 Then lstports.ListItems.item(lstports.ListItems.Count).Checked = True


            
    

 
' Close #1
Exit Sub
err:
 MsgBox err.Description, vbCritical, "Tip !"
End Sub


Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer, flag As Boolean)
  Dim FileName As String
  Dim DirName As String
  Dim dirNames() As String
  Dim nDir As Integer
  Dim I As Integer
  Dim hSearch As Long
  Dim WFD As WIN32_FIND_DATA
  Dim Cont As Integer
  If Right(path, 1) <> "\" Then path = path & "\"
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
      Do While Cont
       DirName = StripNulls(WFD.cFileName)
         If (DirName <> ".") And (DirName <> "..") Then
            If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
              dirNames(nDir) = DirName
              DirCount = DirCount + 1
              nDir = nDir + 1
              ReDim Preserve dirNames(nDir)
            End If
         End If
      Cont = FindNextFile(hSearch, WFD)
     Loop
   Cont = FindClose(hSearch)
 End If
 hSearch = FindFirstFile(path & SearchStr, WFD)
 Cont = True
 If hSearch <> INVALID_HANDLE_VALUE Then
    While Cont
       FileName = StripNulls(WFD.cFileName)
          If (FileName <> ".") And (FileName <> "..") Then
            FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
            FileCount = FileCount + 1
           lstplug.ListItems.Add , path & FileName, FileName
          '  List3.AddItem path & FileName
          '  List2.AddItem FileName
          End If
      Cont = FindNextFile(hSearch, WFD)
   Wend
   Cont = FindClose(hSearch)
 End If
If flag = True Then
 'count of dirs
 If nDir > 0 Then
   For I = 0 To nDir - 1
        FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(I) & "\", SearchStr, FileCount, DirCount, chflag.value)
   Next I
 End If
End If
End Function

Function StripNulls(OriginalStr As String) As String
   If (InStr(OriginalStr, Chr(0)) > 0) Then
      OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
   End If
   StripNulls = OriginalStr
End Function




'Private Sub wsckClient_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
 '   TreeView1.Nodes.Add wsckClient(Index).RemoteHost + CStr(Index), 4, , Description

'End Sub



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Here is the incoming data cached
    Dim DataStr As String
            
    'Read the incoming data and write it to DataStr$
    Call Winsock1.GetData(DataStr$, vbString)
    
    'Update the status bar
    'WriteLogEntry "Receiving data """ & Mid$(DataStr, 1, 64) & """ from the target ...", 6
    Debug.Print DataStr
    
    frmatkreport.ListView1.ListItems.Add , , plugin_name
    sek = frmatkreport.ListView1.ListItems.Count
    frmatkreport.ListView1.ListItems(sek).SubItems(1) = plugin_family
    frmatkreport.ListView1.ListItems(sek).SubItems(2) = plugin_protocol
    frmatkreport.ListView1.ListItems(sek).SubItems(3) = plugin_port
    frmatkreport.ListView1.ListItems(sek).SubItems(4) = bug_risk
   
   If LenB(plugin_procedure_detection) Then
       frmatkreport.ListView1.ListItems(sek).SubItems(5) = plugin_procedure_detection
       frmatkreport.ListView1.ListItems(sek).SubItems(6) = "No"
      
    ElseIf LenB(plugin_procedure_exploit) Then
        frmatkreport.ListView1.ListItems(sek).SubItems(5) = "No"
        frmatkreport.ListView1.ListItems(sek).SubItems(6) = plugin_procedure_exploit
       
    Else
       frmatkreport.ListView1.ListItems(sek).SubItems(5) = "No"
       frmatkreport.ListView1.ListItems(sek).SubItems(6) = "No"
 
    End If
    
    frmatkreport.ListView1.ListItems(sek).SubItems(7) = DataStr
    frmatkreport.ListView1.ListItems(sek).SubItems(9) = CStr(Date) + "  " + CStr(Time$)
    
    If LenB(LastResponse) < 16000 Then
        LastResponse = LastResponse & DataStr
        LastResponseTime = Time
    Else
        Winsock1.Close
    End If

    'Call LoadLatestResponse

    'If IsFormVisible("frmAttackVisualizing") = True Then
    '    frmAttackVisualizing.VisualizeDataArrival
    'End If
 
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
   Winsock1.Close
End Sub


Function readplug(strf As String)
  Dim d As String
        If strf = "" Then Exit Function
         c = FreeFile
        
        Open strf For Binary As #c
            d = String(LOF(c), " ")
            Get #c, , d
        Close #c
    readplug = d
End Function




'==============================================
'==============================================
'==============================================
'==============================================



'==============================================
'==============================================
'==============================================
'==============================================
'==============================================
'==============================================
'==============================================



Private Sub AttackProcedure()
    Dim I As Integer            'The counter
    Dim intFreeFile As Integer  'The free file integer
    Dim Command() As String     'The array with all commands of a plugin
    Dim CommandCount As Integer 'The number of commands in a row
    Dim tader() As String
    
    tader = Split(Combo1.Text, "-")
    
    
    CommandCount = UBound(tader)
   For kk = 0 To CommandCount
    If kk = 0 Then target = tader(0)
    If kk = 1 Then targethost = tader(1)
   Next kk
    
    'Detect DoS and abord if needed
    If InStr(1, bug_vulnerability_class, "Denial of Service") Then
        If application_no_dos_enable = True Then
            'Message if the vulnerability was found
           ' WriteLogEntry "No denial of service checks activated. Abording check.", 3
           ' Call FreeWindows
            Exit Sub
        End If
    End If
    
  '  Call FreezeWindows
    
    'Define the selected request for the attack
    If session_procedure_type = "detection" Then
        session_procedure_commands = plugin_procedure_detection