form2.frm

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

      Top             =   240
      Width           =   975
   End
   Begin VB.Menu flemenu 
      Caption         =   "&File"
      Index           =   1
      Begin VB.Menu savemnu 
         Caption         =   "&Save Scan"
         Enabled         =   0   'False
      End
   End
End
Attribute VB_Name = "form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' by nima bagheri form  [e-mail]
'TEL [phone]


Dim c As Long
Dim i, i2 As Long
Dim i3 As Long



Private Sub Addnew_Click()
 For x = 0 To 3
   If txtip(x).Text <> "" And txtendip(x).Text <> "" Then
        flag = True
   Else
        MsgBox "PLEASE ENTER FULL IP ", , "ERR !"
        Exit Sub
   End If
 Next x
   If flag = True Then
a0 = txtip(0).Text
a1 = txtip(1).Text
a2 = txtip(2).Text
a3 = txtip(3).Text

b0 = txtendip(0).Text
b1 = txtendip(1).Text
b2 = txtendip(2).Text
b3 = txtendip(3).Text

 List1.AddItem Trim(txtip(0).Text + "." + txtip(1).Text + "." + txtip(2).Text + "." + txtip(3).Text)
 cmdSend.Enabled = True
  bip = (CStr(b0) + "." + CStr(b1) + "." + CStr(b2) + "." + CStr(b3))
  ball = AddressStringToLong(bip) 'for check end ip
 
  aip = (CStr(a0) + "." + CStr(a1) + "." + CStr(a2) + "." + CStr(a3))
   aAll = AddressStringToLong(aip) 'for check end ip
    
 
If Abs(ball) = Abs(aAll) Then
      Exit Sub
   End If

 
 Do
 If a3 Mod 250 = 0 Then DoEvents
x:
   a3 = a3 + 1
   aip = (CStr(a0) + "." + CStr(a1) + "." + CStr(a2) + "." + CStr(a3))
   aAll = AddressStringToLong(aip) 'for check end ip
   If Abs(ball) = Abs(aAll) Then
      List1.AddItem aip
      Exit Do
    Else
      List1.AddItem aip
   End If
   
   If a3 > 254 And a2 < b2 Then
       a2 = a2 + 1
       a3 = 0
       GoTo x:
    End If
       If a2 > 254 And a1 < b1 Then
            a1 = a1 + 1
            a2 = 0
            GoTo x:
       End If
 Loop
 cmdSend.Enabled = True
End If

End Sub

Sub aa0(value As Integer)
   value = value + 1
End Sub

Private Sub cmdclear_Click()
  List1.Clear
End Sub

Private Sub cmdCollapse_Click()
  On Error Resume Next
   For e = 1 To TreeView1.Nodes.Count
             TreeView1.Nodes.item(e).Expanded = False
     Next e

End Sub

Private Sub cmddelete_Click()
  If List1.ListIndex <> -1 Then List1.RemoveItem (List1.ListIndex)
End Sub

Private Sub cmdexpand_Click()
  On Error Resume Next
   For e = 1 To TreeView1.Nodes.Count
             TreeView1.Nodes.item(e).Expanded = True
     Next e

End Sub

Private Sub Command1_Click()
   Timer1.Enabled = False
   Call cl
   cmdSend.Enabled = True
End Sub

Private Sub Form_Activate()
  If Me.WindowState <> 2 Then Me.WindowState = 2
End Sub

Private Sub Form_Load()
Me.Hide
 c3
End Sub

Private Sub lblmain_Click()
 Form3.Show
 Me.Hide
 
End Sub

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

Private Sub Timer1_Timer()
If i = wsckClient.Count - 1 Then Load wsckClient(i + 1)
endadd = List1.ListCount * 38
If i >= endadd Then
  Timer1.Enabled = False
  cmdSend.Enabled = Not (cmdSend.Enabled)
    lblstat.Caption = "Scaning Finished ! "
  Call cl
  Exit Sub
End If

v = i \ lstcmd.ListCount
  wsckClient(i).RemoteHost = List1.List(v)
  wsckClient(i).RemotePort = "80"
   
    If v > i3 Then TreeView1.Nodes.Add , , "a" + CStr(v), wsckClient(i).RemoteHost
    i3 = v
   wsckClient(i).Close
   wsckClient(i).Connect
 
i = i + 1
End Sub

Private Sub txtip_Change(Index As Integer)
On Error Resume Next
If txtip(Index) = "" Then txtip(Index) = "0": SendKeys "{HOME}+{END}"
If CInt(txtip(Index).Text) > 255 Then
    MsgBox "Number must be between 0 - 255." & Chr(13) & "Please re-enter number.", vbApplicationModal + vbDefaultButton1 + vbInformation, "Error"
    txtip(Index).Text = "0"
    SendKeys "{HOME}+{END}"
  End If
 
  txtendip(0).Text = txtip(0).Text
  txtendip(1).Text = txtip(1).Text
  txtendip(2).Text = txtip(2).Text

End Sub

Private Sub txtip_GotFocus(Index As Integer)
  SendKeys "{HOME}+{END}"
End Sub
Private Sub txtendip_GotFocus(Index As Integer)
  SendKeys "{HOME}+{END}"
End Sub
Private Sub txtendip_Change(Index As Integer)
On Error Resume Next
If txtendip(Index) = "" Then txtendip(Index) = "0": SendKeys "{HOME}+{END}"
If CInt(txtendip(Index).Text) > 255 Then
    MsgBox "Number must be between 0 - 255." & Chr(13) & "Please re-enter number.", vbApplicationModal + vbDefaultButton1 + vbInformation, "Error"
    txtendip(Index).Text = "0"
    SendKeys "{HOME}+{END}"
  End If
End Sub



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

Private Sub wsckClient_Connect(Index As Integer)
    c = Index
    sendpacket c, cmdes(i2)   'send next packet
     TreeView1.Nodes.Add "a" + CStr(i3), 4, "l" + CStr(Index), "SEND THIS = " + CStr(cmdes(i2))
     'TreeView1.Nodes.item(TreeView1.Nodes.Count).Expanded = True
     'TreeView1.Nodes.item(TreeView1.Nodes.Count).EnsureVisible
  
     i2 = i2 + 1
     If i2 > lstcmd.ListCount Then i2 = 0
End Sub
  
Private Sub wsckClient_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  'Text3 is show resv
  Dim msg As String
  wsckClient(Index).GetData msg
     
 'b = 1
  'If Len(msg) > 10 Then
    'Do
    'b = InStr(b + 1, msg, vbCrLf)
    'b2 = InStr(b + 1, msg, vbCrLf)
    'If b2 = 0 Then b2 = Len(msg)
     'If b > 0 Then
       '  msg1 = Mid(msg, b, b2)
      'If Len(msg1) > 5 Then TreeView1.Nodes.Add "a" + CStr(i3), 4, , msg1
     'End If
    'Loop Until b = 0 Or b2 = 0
   TreeView1.Nodes.Add "l" + CStr(Index), 4, , msg

  'End If
End Sub
Private Sub cmdSend_Click()
 cmdSend.Enabled = False
  Timer1.Interval = CStr(txtdelay.Text)
 TreeView1.Nodes.Clear
  Timer1.Enabled = True
  i = 0
  i2 = 0
  i3 = -1
End Sub

Sub sendpacket(target As Long, strHttpRequest As String)
On Error GoTo last
      wsckClient(target).SendData strHttpRequest
   Exit Sub
last:
   If err.Number = 40006 Then
    wsckClient(target).Close
    
End If

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)
    TreeView1.Nodes.Add "a" + CStr(i3), 4, "l" + CStr(Index), Description
    TreeView1.Nodes.Add "l" + CStr(Index), 4, , Description
End Sub

Sub cl()
  For j = 0 To i
      wsckClient(j).Close
  Next j
 
End Sub

Function createhtml() As String
 Dim b As String
 Const cr = vbCrLf
  createhtml = "<html>" + cr + "<head>" + cr + "<title> THE CRACKERS GROUP SCANNER  </title>" + cr + "</head>" + "<body>" + cr
   b = b + "<p><font size=" + Chr(34) + "7" + Chr(34) + ">&nbsp;THE CRACKERS GROUP</font></p>"
   b = b + " <b>TARGET CGI SYSTEM SCANNER  </b> <br>"
  For l = 1 To TreeView1.Nodes.Count
    If TreeView1.Nodes.item(l).Children <> 0 Then
       b = b + "<p>" + "<font color=" + Chr(34) + "#FFFFFF" + Chr(34) + ">"
       b = b + "<span style=" + Chr(34) + "background-color: #3366CC" + Chr(34) + ">"
       b = b + "IP Address : " + TreeView1.Nodes.item(l).Text + "</span></font><br>"
       b = b + "Details :" + "<br>"
        For l2 = l + 1 To l + TreeView1.Nodes.item(l).Children
             b = b + TreeView1.Nodes.item(l2).Text + "<br>"
        Next l2
     b = b + "</p>"
    End If
  Next l
 createhtml = createhtml + b
 createhtml = createhtml + "</body>" + cr + "</html>" + cr


'<p>----127.0.0.1<br>
'-----------123213<br>
'-----------1233 </p>

'</body>

'</html>




End Function


Function cmdes(id As Long)

 cmdes = a(id)

End Function