frmnettools.frm

网路IP小工具,包括扫瞄,Ping,多线Ping.

            Percent = Round(ProgressScan * 100 / ProgressScan.Max) & "%"
        End If
        LastPort = CurPort
    End If
End Sub

Private Sub chkTo_Click()
    'User enables Interval Search:
    If chkTo.Value = 0 Then
        txtLast.Enabled = False
    Else
        txtLast.Enabled = True
    End If
End Sub

Private Sub cmdAdd_Click()
    If Not Working Then
        Working = True
        cmdAdd.Caption = "Stop"
        If IsAddress(txtIP) Then
            'Data is an IP adress:
            
            If chkTo.Value = 1 Then
                
                If Trim(txtLast) = "" Then 'Trim is used to "clean" adjacent spaces
                'User forgot to insert an address let's just ignore the interval:
                    If Not EntryExists(txtIP, lstAdr) Then
                        'Single address entry:
                        'There is no repeated entry, ok to proceed:
                        lstAdr.AddItem txtIP
                        'Check if Rem button is enabled
                        If cmdDel.Enabled = False Then cmdDel.Enabled = True
                    End If
                
                ElseIf IsAddress(txtLast) Then 'User has inserted some value
                    'Interval of Adresses search routine:
                    Dim FirstAddr As Double, LastAddr As Double, IpAddr As String, CurAddr As Double
                    'First and last address converted to long so they can be calculated later:
                    FirstAddr = AddrToLong(txtIP)
                    LastAddr = AddrToLong(txtLast)
                    'Obviously first addr must be smaller
                    If FirstAddr < LastAddr Then  'OK to proceed
                        For CurAddr = FirstAddr To LastAddr
                            'From first address to the last:
                            'Convert it to IP - string - so we can show it in list
                            IpAddr = LongToAddr(CurAddr)
                            If Not EntryExists(IpAddr, lstAdr) Then
                                'Assure there are no duplicates
                                lstAdr.AddItem IpAddr
                            End If
                            'we don't wan't to make our app to "freeze"
                            DoEvents
                            'check if user pressed cancel
                            If Not Working Then GoTo CleanUp
                        Next CurAddr
                    End If
                    'at least one entry was made, so let's check for Remove button:
                    If cmdDel.Enabled = False Then cmdDel.Enabled = True
                End If
            
            'No interval search (not checked)
            ElseIf Not EntryExists(txtIP, lstAdr) Then
                'Single address entry:
                'No repeated entry, ok to proceed...
                lstAdr.AddItem txtIP
                'Check if Rem button is enabled
                If cmdDel.Enabled = False Then cmdDel.Enabled = True
            End If
        End If
    Else
        Working = False
        Exit Sub
    End If
CleanUp:
    'Clean up process:
    txtIP = "": txtLast = ""
    cmdAdd.Caption = "Add"
    
End Sub

Private Sub cmdDel_Click()
    With lstAdr
        'Assure error free:
        If .ListCount = 0 Then cmdDel.Enabled = False: Exit Sub
        'Assure there is somethin selected
        If .ListIndex > -1 Then
            If .Selected(.ListIndex) Then
                .RemoveItem .ListIndex
            End If
        End If
        'If for some reason it's still enabled and
        'there's nothin to delete, disable button:
        If .ListCount = 0 Then cmdDel.Enabled = False
    End With
End Sub

Private Sub lstAdr_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    'To spare some resources let's do this only when it's needed:
    Static LastCount As Long
    'Check if value has changed so we can or not refresh tooltip text:
    If LastCount <> lstAdr.ListCount Then
        If lstAdr.ListCount = 1 Then
            'Only one address to ping:
            lstAdr.ToolTipText = lstAdr.ListCount & " address to ping"
        ElseIf lstAdr.ListCount = 0 Then
            'No addresses to ping:
            lstAdr.ToolTipText = "No addresses to ping"
        Else
            'More than one address to ping:
            lstAdr.ToolTipText = lstAdr.ListCount & " addresses to ping"
        End If
        'Refresh last value:
        LastCount = lstAdr.ListCount
    End If
End Sub

Private Sub lstAdr_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    'Enable drag and drop support:
    Dim Addr As String
    'Check the kind of incoming value
    Addr = data.GetData(vbCFText)
    'Check if is an address
    If IsAddress(Addr) Then
        'Check if it exists in list:
        If Not EntryExists(Addr, lstAdr) Then
            lstAdr.AddItem Addr
            If cmdDel.Enabled = False Then cmdDel.Enabled = True
        End If
    End If
End Sub

Private Sub txtIP_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    'Enable dragdrop in textbox:
    Dim Addr As String
    Addr = data.GetData(vbCFText)
    If IsAddress(Addr) Then
        txtIP = Addr
    End If
End Sub

Private Sub txtLast_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    'Enable dragdrop in textbox:
    Dim Addr As String
    Addr = data.GetData(vbCFText)
    If IsAddress(Addr) Then
        txtLast = Addr
    End If
End Sub

Function EntryExists(Entry As String, List As ListBox) As Boolean
    With List
        'Simple loop in matching each value of each list value with the disired
        Dim i As Integer, Last As Integer
        EntryExists = False
        Last = .ListCount - 1
        If Last < 0 Then Exit Function
        For i = 0 To Last
            If .List(i) = Entry Then
                EntryExists = True
                Exit Function
            End If
        Next i
    End With
End Function

Sub StartPing()
    If Working Then Working = False: Exit Sub 'User pressed then stop working
    If lstAdr.ListCount = 0 Then GoTo CleanUp
    'Start working:
    Working = True
    'Enable cancel button
    cmdStart.Caption = "Cancel"
    Dim i As Long, Elapsed As Long, Remaining As Long, ret As Long
    'Initialize progress bar
    ProgressPing.Min = 0
    ProgressPing.Max = lstAdr.ListCount - 1
    
    'Start ping loop:
    For i = 0 To ProgressPing.Max
        'Initialize clock:
        Elapsed = GetTickCount
        'Change progressbar:
        ProgressPing = i
        'Check if user pressed cancel:
        If Not Working Then
            txtLog = txtLog & "Operation aborted by user!" & vbNewLine
            GoTo CleanUp
        End If
        'Status
        lblPingStatus = "Pinging: " & lstAdr.List(i) & vbLf & "Hosts remaining: " & ProgressPing.Max - ProgressPing & vbLf & "Estimated time: " & Round((ProgressPing.Max - ProgressPing) * Remaining / 1000, 3) & " secs"
        'Refresh form, if ommited user can't cancel operation:
        DoEvents
        'ret->delay of ping
        'Ping host:
        ret = PingHostByAdress(lstAdr.List(i))
        If ret >= 0 Then
            txtLog = txtLog & lstAdr.List(i) & ": " & ret & " ms" & vbNewLine
            DoEvents
            If Not Working Then
                txtLog = txtLog & "Operation aborted by user!" & vbNewLine
                GoTo CleanUp
            End If
        End If
        
        'This sets the delay of last action that will be used
        'for calculating remaining time:
        Remaining = GetTickCount - Elapsed
Next i
CleanUp:
    'Safest way of cleaning progress bar:
    ProgressPing = ProgressPing.Min
    'Reset button caption:
    cmdStart.Caption = "Start"
    'Work is done
    Working = False
    'Clean status label:
    lblPingStatus = vbLf & vbLf & "Percentage Done"
End Sub

Sub StartScan(Optional Host As String, Optional Cancel As Boolean)
    If Cancel Or bolStop Then GoTo CleanUp
    Scanning = True
    If Host = "" Then Host = txtIP
    If Not IsAddress(Host) Then
            MsgBox "Invalid IP address to scan.", vbCritical, "Initialize Error"
            GoTo CleanUp
    End If
    
    If Not Working Then
        Working = True
        cmdStart.Caption = "Cancel"
        Dim ret As Long
        StatusBar.SimpleText = "Pinging " & Host & "..."
        ret = PingHostByAdress(Host)
        If ret < 0 Then
            GoTo CleanUp
        Else
            StatusBar.SimpleText = Host & " reply: " & ret & " ms"
        End If
        'Disable controls and change caption:
        fraPingHost.Enabled = False
        fraPortSettings.Enabled = False
        
        'Simple Mode:
        If chkPortAdv.Value = 0 Then
            'Check values:
            If IsNumeric(txtStartPort) And IsNumeric(txtEndPort) Then
                'Both values must be integer!
                If (Int(txtStartPort) - Val(txtStartPort)) <> 0 Or (Int(txtEndPort) - Val(txtEndPort)) <> 0 Then
                    MsgBox "One of the ports has a non integer value!", vbCritical, "Initialize Error"
                    GoTo CleanUp
                Else
                    StartPort = CInt(txtStartPort.Text)
                    EndPort = CInt(txtEndPort.Text)
                    Debug.Print StartPort; EndPort
                    If StartPort >= txtEndPort Then
                        If MsgBox("Starting Port is bigger than ending Port. Ending Port will be set to a bigger value", vbCritical Or vbOKCancel, "Initialize Error") = vbOK Then
                            EndPort = StartPort + 1
                        Else
                            GoTo CleanUp
                        End If
                    End If
                    'Check port in interval of values
                    If StartPort < 1 Then StartPort = 1
                    If StartPort >= 32767 Then StartPort = 32766
                    If EndPort > 32767 Then EndPort = 32767
                    If EndPort < 2 Then EndPort = 2
                End If
            Else
                MsgBox "On of the ports has a non numerical value!", vbCritical, "Initialize Error"
                GoTo CleanUp
            End If
            
            CurPort = StartPort 'Sets the global variable (set up at the top) to the first port the user wants scanned
            LastPort = 0 'used for stats only
            ProgressScan.Max = EndPort
            ProgressScan.Min = StartPort
            ProgressScan = StartPort
            'Actualize any changed data
            txtStartPort = StartPort: txtEndPort = EndPort
            LastOpenPort = 0
            
            sckScan.Close                       'Close the control
            sckScan.RemoteHost = Host           'This sets all the controls to want to connect to the target the user specified
            sckScan.RemotePort = CurPort        'Sets the port needed to be scanned
            sckScan.Connect                     'Try to get it to connect
            CurPort = CurPort + 1               'Makes curport get larget by one for the next control
            lblStatus.Caption = "Status - Scanning port:"
            Port = CurPort 'Sets the status message to display the port currently being scanned
                    
        'Advanced Mode:
        Else
            If lstPortInterval.ListCount = 0 Then
                MsgBox "No ports to scan!", vbCritical, "Initialize Error"
                GoTo CleanUp
            End If
            Dim i As Integer
            'Redimension array of selected ports:
            ReDim PortInt(lstPortInterval.ListCount - 1)
            For i = 0 To lstPortInterval.ListCount - 1
                'Set port
                PortInt(i) = lstPortInterval.List(i)
            Next i
            
            CurPort = 0 'Sets the global variable (set up at the top) to the first port the user wants scanned
            LastPort = 0 'used for stats porpose only
            ProgressScan.Max = lstPortInterval.ListCount - 1
            ProgressScan.Min = 0
            ProgressScan = 0
            'Actualize any changed data
            
            'Close the control
            sckScan.Close
            'This sets all the controls to want to connect to the target the user specified
            sckScan.RemoteHost = Host
            'Sets the port needed to be scanned
            sckScan.RemotePort = PortInt(CurPort)
            'Try to get it to connect
            sckScan.Connect
            'Makes curport get larget by one for the next control
            CurPort = CurPort + 1
            lblStatus.Caption = "Status - Scanning port:"
            'Sets the status message to say the port currently being scanned
            Port = CurPort
        
        End If
        
        txtLog = txtLog & "Scanning " & Host & "..." & vbNewLine
        tmrCheckStatus.Enabled = True   'The timer is sort of like the clean up person...it looks for controls that haven't connected and are just sitting there and assigns them a new port
        tmrStats.Enabled = True
    Else
CleanUp:
        Working = False
        cmdStart.Caption = "Start"      'Sets the caption back if the user wants to go again
        tmrCheckStatus.Enabled = False  'Stop the timer
        tmrStats.Enabled = False
        lblStatus.Caption = "Status - Idle" 'Sets the label status
        sckScan.Close
        If Action <> 3 Then txtStartPort = CurPort - 1
        CurPort = 0
        If CInt(txtStartPort) < 1 Then txtStartPort = 1
        Rate = ""
        fraPingHost.Enabled = True
        fraPortSettings.Enabled = True
        Port = ""
        RemPort = ""
        Rate = ""
        ProgressScan = ProgressScan.Min
        Metrics.Visible = False
        EstRem = ""
        Percent = ""
        'On Error Resume Next
        'Set flag for multiple hosts scan
        Scanning = False
    End If
End Sub

Sub SafeDeclare(SetVar As Variant, ValVar As Variant)
    'very usefull for when it comes to graphs
    'it makes the best use of resources and controls flickering
    If SetVar <> ValVar Then SetVar = ValVar
End Sub