form1.frm

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

      Index           =   1
      Begin VB.Menu savemnu 
         Caption         =   "&Save Scan"
         Enabled         =   0   'False
      End
   End
End
Attribute VB_Name = "form1"
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 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
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 ", , "WARNING"
   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()
On Error Resume Next
If I = wsckClient.Count - 1 Then Load wsckClient(I + 1)


Dim strs As String
If I >= List1.ListCount - 1 Then
  Timer1.Enabled = False
  cmdSend.Enabled = Not (cmdSend.Enabled)
'  lblstat.Caption = "Scaning Finished ! "
  
  Call cl
End If

   wsckClient(I).Close
   wsckClient(I).RemoteHost = List1.List(I)
   wsckClient(I).RemotePort = "80"
   TreeView1.Nodes.Add , , wsckClient(I).RemoteHost, wsckClient(I).RemoteHost
   'TreeView1.Nodes.item(TreeView1.Nodes.Count).Expanded = True
   'TreeView1.Nodes.item(TreeView1.Nodes.Count).EnsureVisible
  
   wsckClient(I).Connect


I = I + 1

End Sub

Private Sub txtendip_GotFocus(Index As Integer)
  SendKeys "{HOME}+{END}"
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 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 txtip_GotFocus(Index As Integer)
  SendKeys "{HOME}+{END}"
End Sub

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

Private Sub wsckClient_Connect(Index As Integer)
  sendpacket (Index)
 
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
  
  lenurl = InStr(1, msg, "text/html")
   If lenurl > 0 Then msg = Mid(msg, 1, lenurl + 9) Else Exit Sub
  

 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)
        TreeView1.Nodes.Add wsckClient(Index).RemoteHost, 4, , msg1
     End If
    Loop Until b = 0 Or b2 = 0

  End If
End Sub
Private Sub cmdSend_Click()
 cmdSend.Enabled = False
  Timer1.Interval = CStr(txtdelay.Text)

 TreeView1.Nodes.Clear
  Timer1.Enabled = True
  I = 0
End Sub

Sub sendpacket(target As Long)
On Error GoTo last
    'http://www.example.com/scripts/..%255c..%255cwinnt/system32/cmd.exe?/c+dir c:\
    If Option1.value = True Then
      
      
      strHttpRequest = "GET " & "/" & " HTTP/1.1" & vbCrLf & vbCrLf
     ElseIf Option2.value = True Then
      strHttpRequest = "HEAD " & "/" & " HTTP/1.1" & vbCrLf & vbCrLf
     End If
      
      wsckClient(target).SendData strHttpRequest
       

   Exit Sub
last:
   If err.Number = 40006 Then
    wsckClient(target).Close
    'Timer1.Enabled = False
   'MsgBox "Not connected, Try again"
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 wsckClient(Index).RemoteHost, 4, , Description
End Sub

Sub cl()
  For J = 0 To I
      wsckClient(I).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 OPRATION SYSTEM SCANNER  </b> <br>"
  
  For l = 1 To TreeView1.Nodes.Count
   For l1 = 1 To TreeView1.Nodes.item(l).Children
       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>"
   Next l1
  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