frmping.frm

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

      Index           =   1
      Begin VB.Menu savemnu 
         Caption         =   "&Save Scan"
      End
   End
End
Attribute VB_Name = "frmping"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' by nima bagheri form  [e-mail]
'TEL [phone]




Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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
lblstat.Caption = "Ready..."
End Sub

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

Private Sub cmdaddport_Click()
  frmaddport.Show
End Sub

Private Sub cmdclear_Click()
 List1.Clear
End Sub

Private Sub cmdCollapse_Click()
     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()
     For e = 1 To TreeView1.Nodes.Count
             TreeView1.Nodes.item(e).Expanded = True
            ' TreeView1.Nodes.Item(e).EnsureVisible
     Next e
  
End Sub


Private Sub Command1_Click()
  Timer1.Enabled = False
  cmdSend.Enabled = True
  lblstat.Caption = "Stop Scan..."
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()
On Error GoTo err:
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
Exit Sub
err:
 MsgBox err.Description
 
End Sub

Private Sub Timer1_Timer()

If I = List1.ListCount Then Timer1.Enabled = False: cmdSend.Enabled = True: lblstat.Caption = "Scan Completed...": Exit Sub
  
  

Dim ECHO As ICMP_ECHO_REPLY
   Dim pos As Integer
   
     Call Ping(List1.List(I), ECHO)
     

    TreeView1.Nodes.Add , , List1.List(I), List1.List(I)
    
    TreeView1.Nodes.Add List1.List(I), 4, , "status = " + GetStatusCode(ECHO.Status)
    TreeView1.Nodes.Add List1.List(I), 4, , "Address = " + CStr(ECHO.Address)
    TreeView1.Nodes.Add List1.List(I), 4, , "RoundTripTime = " + CStr(ECHO.RoundTripTime) & " ms"
    TreeView1.Nodes.Add List1.List(I), 4, , "DataSize = " + CStr(ECHO.datasize) & " bytes"
   
   If Left$(ECHO.Data, 1) <> Chr$(0) Then
      pos = InStr(ECHO.Data, Chr$(0))
     TreeView1.Nodes.Add List1.List(I), 4, , "Data = " + CStr(Left$(ECHO.Data, pos - 1))
   End If

     TreeView1.Nodes.Add List1.List(I), 4, , "DataPointer = " + CStr(ECHO.DataPointer)


 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 cmdSend_Click()
 cmdSend.Enabled = False
'  Timer1.Interval = CStr(txtdelay.Text)

   lblstat.Caption = "Starting..."
   For co = 0 To List1.ListCount
    For cp = co + 1 To List1.ListCount
       If List1.List(co) = List1.List(cp) Then List1.RemoveItem (cp)
    Next cp
   Next co

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




Function createhtml() As String
 Dim b As String
 Const cr = vbCrLf
  createhtml = frmrprt.txtheadhtml1.Text
  'frmrprt
 
    For l = 1 To TreeView1.Nodes.Count
     
      If TreeView1.Nodes.item(l).Children <> 0 Then
          
            b = b + frmrprt.txtheadhtml2.Text + TreeView1.Nodes(l).Text + "</span></font><br>"
             
            b = b + frmrprt.txtheadhtml3.Text
                   
             b = b + frmrprt.txtheadhtml4.Text
                            
                      For l1 = l + 1 To l + TreeView1.Nodes.item(l).Children
                           On Error GoTo errnext:
                                       b = b + "&nbsp;&nbsp" + TreeView1.Nodes.item(l1).Text + "<br>"
                          
                      Next l1
             b = b + "</div>"
       End If
errnext:
     Next l
  
 createhtml = createhtml + b + "</body></html>"

End Function