frmmain.frm

Ping,扫描,Whois IP

Private Sub cmdClear_Click()
    rtxtIP.Text = ""
    txtDataSend.Text = ""
    txtUserName.Text = ""
    txtStatus.Text = ""
    txtLag.Text = ""
    txtPortAddress.Text = ""
    txtEcho.Text = ""
    txtPacketSize.Text = ""
    txtIp_Scan(3).Text = ""
    sbMain.Panels(1).Text = ""
    txtIp_IP(3).SetFocus
End Sub

Private Sub cmdPrint_Click()
    rtxtIP.SelPrint (Printer.hDC)
End Sub

Private Sub cmdPing_Click()
        
    On Error GoTo errorTCP

    Dim intCount As Integer
    For intCount = 0 To 3
        If txtIp_IP(intCount).Text = "" Then
            MsgBox "You must enter a valid IP Address", vbOKOnly, "Invalid IP"
            Exit Sub
        End If
    Next intCount
    
    If TxtRemotePort.Text = "" Then
        MsgBox "You must enter a valid port address", vbOKOnly, "Invalid Port"
        Exit Sub
    End If
    
    sbMain.Panels(1).Text = ""
    If txtIp_Scan(3).Text = "" Then                         'if there is not second ip then perform a ping else perform range ip scan
        PingSingle
    Else
        cmdPing.Enabled = False                             'put together ips
        cmdStopPing.Enabled = True
        sbMain.Panels(1).Text = "Begin IP Scan"
        rtxtIP.Text = ""
        rtxtIP.Text = rtxtIP.Text & "RemotePort: " & TxtRemotePort.Text & vbCrLf
        strIPScan = txtIp_IP(0).Text & "." & txtIp_IP(1).Text & "." & txtIp_IP(2).Text
        IPBegScan = txtIp_IP(3).Text
        IPEndScan = txtIp_Scan(3).Text
        boolIPScan = True                                   'set a switch for ip scanning - will be used when stopping
        tmrPing.Enabled = True                              'start ip scanning
    End If
    Exit Sub
    
errorTCP:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume Next
    End If
    
End Sub

Private Sub PingSingle()

    On Error GoTo errorTCP

    Dim ECHO As ICMP_ECHO_REPLY
    Dim pos As Integer
    Dim strIP As String
    Dim intCount As Integer
        
    cmdPing.Enabled = False
    
                                                                'put ip address together
    strIP = txtIp_IP(0).Text & "." & txtIp_IP(1).Text & _
                "." & txtIp_IP(2).Text & "." & txtIp_IP(3).Text
    
    sbMain.Panels(1).Text = "Pinging  " & strIP                 'return data from ping
    Call Ping(strIP, txtDataSend.Text, ECHO)
    txtUserName.Text = IPtoDNS(strIP)
    txtStatus.Text = GetStatusCode(ECHO.status)
    txtLag.Text = ECHO.RoundTripTime & " milliseconds"
    txtPortAddress.Text = ECHO.Address
    txtEcho.Text = ECHO.Data & " Data"
    txtPacketSize.Text = ECHO.DataSize & " bytes"
    If Left$(ECHO.Data, 1) <> Chr$(0) Then
        pos = InStr(ECHO.Data, Chr$(0))
        txtEcho.Text = Left$(ECHO.Data, pos - 1)
    End If
    sbMain.Panels(1).Text = "Pinging  " & strIP & "  complete."
    
    cmdPing.Enabled = True
    Exit Sub

errorTCP:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume Next
    End If
End Sub

''''''''''''''''''''''''''''''''''PORT SCAN TAB'''''''''''''''''''''''''''''''''''''''''
Private Sub cmdClearList_Click()
   lstOpenPorts.Clear
   sbMain.Panels(1).Text = ""
End Sub

Private Sub cmdScan_Click()

    On Error GoTo errorTCP
    
    Dim intCount As Integer
    
    cmdScan.Enabled = False
    cmdStop.Enabled = True
    sbMain.Panels(1).Text = ""
    For intCount = 0 To 3                                       'verify ip
        If txtIP_Port(intCount).Text = "" Then
            MsgBox "You must enter a valid IP Address", vbOKOnly, "Invalid IP"
            Exit Sub
        End If
    Next intCount
    
                                                                'put together ip
    strPortIP = txtIP_Port(0).Text & "." & txtIP_Port(1).Text & "." & _
                txtIP_Port(2).Text & "." & txtIP_Port(3).Text

    lstOpenPorts.Clear
    NextPort = txtBegPort.Text                                  'set starting port
    lstOpenPorts.AddItem "Initializing Port Scan"
    boolPortScan = True                                         'set switch - used for stopping port scan
    tmrPing.Enabled = True                                      'start scan
    Exit Sub
    
errorTCP:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume Next
    End If
    
    
End Sub

Private Sub PortScan()

    On Error GoTo errorTCP
    
    If NextPort <= txtEndPort.Text And boolPortScan = True Then 'if we reached end point or stop was pushed
        DoEvents                                                'important to release for arrival procedure
        tcpPing.Close                                           'be sure it is not already open
        NextPort = NextPort + 1                                 'increment ports
        tcpPing.RemoteHost = strPortIP                          'set ip
        tcpPing.RemotePort = NextPort                           'set the port
        tcpPing.Connect                                         'connect
    Else
        tcpPing.Close                                           'if stopped enable buttons
        cmdScan.Enabled = True
        cmdStop.Enabled = False
        tmrPing.Enabled = False
    End If
    Exit Sub
    
errorTCP:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume Next
    End If
End Sub

Private Sub cmdStop_Click()
    boolPortScan = False                                        'set bool switch to stop port scan
End Sub

''''''''''''''''''''''''''''''''''IP SCAN'''''''''''''''''''''''''''''''''''''''''

Private Sub ScanIP()

    On Error GoTo errorTCP
    
    If IPBegScan <= IPEndScan And boolIPScan = True Then        'if we reached end point or stop was pushed
        DoEvents                                                'important to release for arrival procedure
        If tcpPing.State <> sckClosed Then tcpPing.Close        'if socket isn't closed then close it before setting props
        IPBegScan = IPBegScan + 1                               'increment ip
        tcpPing.RemoteHost = strIPScan & "." & IPBegScan        'set ip
        tcpPing.RemotePort = TxtRemotePort.Text                 'set port
        tcpPing.Connect                                         'connect
    Else
        cmdPing.Enabled = True                                  'if stopped enable buttons
        cmdStopPing.Enabled = False
        tmrPing.Enabled = False
        If IPBegScan <= IPEndScan Then                          'if we stopped before ending scan then set text
            sbMain.Panels(1).Text = "IP Scan Stopped at " & IPBegScan
        Else
            sbMain.Panels(1).Text = "IP Scan Complete"
        End If
    End If
    Exit Sub
    
errorTCP:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume Next
    End If
End Sub

Private Sub cmdStopPing_Click()
    boolIPScan = False                                      'ip scan bool for testing if we user wants to stop
End Sub

Public Function IPtoDNS(ByVal strAddress As String) As String
    
    On Error GoTo errorTCP
    
    Dim Host As HOSTENT
    Dim lAddress As Long
    Dim lTemp As Long
    Dim strHostName As String
    
    lAddress = inet_addr(strAddress)
    lTemp = gethostbyaddr(lAddress, 4, PF_INET)
    If lTemp <> 0 Then
        CopyMemory Host, ByVal lTemp, Len(Host)
        strHostName = String(256, 0)
        CopyMemory ByVal strHostName, ByVal Host.hName, 256
        If strHostName = "" Then
            IPtoDNS = "DNS error : resolution impossible " & Str$(WSAGetLastError())
        Else
            IPtoDNS = Left(strHostName, InStr(strHostName, Chr(0)) - 1)
        End If
    Else
        IPtoDNS = "Unable to determine name"
    End If
    Exit Function
    
errorTCP:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
        Resume Next
    End If
    
End Function

''''''''''''''''''''''''''''''''''WHOIS TAB'''''''''''''''''''''''''''''''''''''''''
Private Sub CmdWhois_Click()
    
    tcpPing.RemotePort = 43                                     'port 43 is who is
    tcpPing.RemoteHost = txtInfoSource
    tcpPing.Connect
    While tcpPing.State <> sckConnected                         'loop until connected or errored out(can put timeout here)
        If tcpPing.State = sckError Then                        'if errored then exit
            TxtWhois.Text = TxtWhois.Text & " " & txtInfoSource.Text & " not responding."
            Exit Sub
        End If
        DoEvents
    Wend
    tcpPing.SendData txtDomainName.Text & vbCrLf                'if we reached this point then send name of address
    
End Sub


''''''''''''''''''''''''''''''''''SYS INFO TAB'''''''''''''''''''''''''''''''''''''''''
Private Sub CpuInfo()
 
    txtMyOS.Text = GetWindowsVersion()                          'api calls to pull cpu info
    txtMyCPUName.Text = ComputerName()
    txtMyIP.Text = tcpPing.LocalIP
    txtMyHostName.Text = tcpPing.LocalHostName
    txtMyUserName.Text = modUserName.UserName()
    txtMyEthernet.Text = EthernetAddress(0)
    If txtMyEthernet.Text = "000000000000" Then
        txtMyEthernet.Text = "No Ethernet Card Detected"
    End If
    
End Sub



''''''''''''''''''''''''''''''''''Textbox Controls'''''''''''''''''''''''''''''''''''''''''
Private Sub txtIp_IP_LostFocus(Index As Integer)
    If Index = 3 Then
        Dim intCount As Integer
        For intCount = 0 To 2
            txtIp_Scan(intCount).Text = txtIp_IP(intCount).Text
            txtIP_Port(intCount).Text = txtIp_IP(intCount).Text
        Next intCount
    End If
End Sub

Private Sub txtIP_Port_LostFocus(Index As Integer)
    If Index = 3 Then
        Dim intCount As Integer
        For intCount = 0 To 2
           txtIp_IP(intCount).Text = txtIP_Port(intCount).Text
        Next intCount
    End If
End Sub

Private Sub txtIP_Port_GotFocus(Index As Integer)
    Focus txtIP_Port(Index)
End Sub

Private Sub txtIP_Port_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = Asc(".") Then SendKeys "{TAB}"
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Num")
End Sub

Private Sub txtBegPort_GotFocus()
    Focus txtBegPort
End Sub

Private Sub txtEndPort_GotFocus()
    Focus txtEndPort
End Sub

Private Sub txtBegPort_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Num")
End Sub

Private Sub txtEndPort_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Num")
End Sub

Private Sub txtIp_IP_GotFocus(Index As Integer)
    Focus txtIp_IP(Index)
End Sub

Private Sub txtDomainName_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Alpha")
End Sub

Private Sub TxtRemotePort_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Num")
End Sub

Private Sub txtIp_IP_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = Asc(".") Then SendKeys "{TAB}"
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Num")
End Sub

Private Sub txtIp_Scan_GotFocus(Index As Integer)
    Focus txtIp_Scan(Index)
End Sub

Private Sub txtIp_Scan_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = Asc(".") Then SendKeys "{TAB}"
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Num")
End Sub

Private Sub TxtRemotePort_GotFocus()
    Focus TxtRemotePort
End Sub

Private Sub txtDataSend_GotFocus()
    Focus TxtRemotePort
End Sub

Private Sub txtDataSend_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then SendKeys "{TAB}"
    KeyAscii = KeyCheck(KeyAscii, "Alpha")
End Sub