frmnewscan.frm

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

VERSION 5.00
Begin VB.Form frmnewscan 
   BackColor       =   &H00000000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "New Scan"
   ClientHeight    =   3885
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5145
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3885
   ScaleWidth      =   5145
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1320
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   3240
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Finish"
      Height          =   375
      Left            =   3120
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   3240
      Width           =   1575
   End
   Begin VB.TextBox txthost 
      Height          =   285
      Left            =   2640
      TabIndex        =   2
      Top             =   120
      Width           =   2295
   End
   Begin VB.OptionButton Option2 
      BackColor       =   &H00FFFFFF&
      Caption         =   " Part of a Network Domain"
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   720
      Width           =   3135
   End
   Begin VB.OptionButton Option1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Hostname / IP address :"
      Height          =   195
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Value           =   -1  'True
      Width           =   2535
   End
End
Attribute VB_Name = "frmnewscan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
  If Option1.value = True Then
       
    Dim lngPtrToHOSTENT As Long
    Dim udtHostent      As HOSTENT1
    Dim lngPtrToIP      As Long
    Dim arrIpAddress()  As Byte
    Dim strIpAddress    As String
    lngPtrToHOSTENT = gethostbyname(Trim$(txthost.Text))
    'txthost
    If lngPtrToHOSTENT = 0 Then
        ShowErrorMsg (err.LastDllError)
    Else
        RtlMoveMemory udtHostent, lngPtrToHOSTENT, LenB(udtHostent)
        RtlMoveMemory lngPtrToIP, udtHostent.hAddrList, 4
        Do Until lngPtrToIP = 0
            ReDim arrIpAddress(1 To udtHostent.hLength)
            RtlMoveMemory arrIpAddress(1), lngPtrToIP, udtHostent.hLength
            For I = 1 To udtHostent.hLength
                strIpAddress = strIpAddress & arrIpAddress(I) & "."
            Next
            strIpAddress = Left$(strIpAddress, Len(strIpAddress) - 1)
            
            frmwebatk.Combo1.AddItem strIpAddress + "-" + txthost.Text, 0
            
            strIpAddress = ""
            udtHostent.hAddrList = udtHostent.hAddrList + LenB(udtHostent.hAddrList)
            RtlMoveMemory lngPtrToIP, udtHostent.hAddrList, 4
         Loop
         Unload Me
    End If
  
   
 End If
  
  
  

End Sub

Private Sub Command2_Click()
 Unload Me
End Sub

'=====================================

Private Sub Form_Load()
    '
    Dim lngRetVal      As Long
    Dim strErrorMsg    As String
    Dim udtWinsockData As WSADATA
    Dim lngType        As Long
    Dim lngProtocol    As Long
    lngRetVal = WSAStartup(&H101, udtWinsockData)
    '
    If lngRetVal <> 0 Then
        '
        '
        Select Case lngRetVal
            Case WSASYSNOTREADY
                strErrorMsg = "The underlying network subsystem is not " & _
                    "ready for network communication."
            Case WSAVERNOTSUPPORTED
                strErrorMsg = "The version of Windows Sockets API support " & _
                    "requested is not provided by this particular " & _
                    "Windows Sockets implementation."
            Case WSAEINVAL
                strErrorMsg = "The Windows Sockets version specified by the " & _
                    "application is not supported by this DLL."
        End Select
        '
        MsgBox strErrorMsg, vbCritical
        '
    End If
    '
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call WSACleanup
End Sub

Private Sub ShowErrorMsg(lngError As Long)
    '
    Dim strMessage As String
    '
    Select Case lngError
        Case WSANOTINITIALISED
            strMessage = "A successful WSAStartup call must occur " & _
                         "before using this function."
        Case WSAENETDOWN
            strMessage = "The network subsystem has failed."
        Case WSAHOST_NOT_FOUND
            strMessage = "Authoritative answer host not found."
        Case WSATRY_AGAIN
            strMessage = "Nonauthoritative host not found, or server failure."
        Case WSANO_RECOVERY
            strMessage = "A nonrecoverable error occurred."
        Case WSANO_DATA
            strMessage = "Valid name, no data record of requested type."
        Case WSAEINPROGRESS
            strMessage = "A blocking Windows Sockets 1.1 call is in " & _
                         "progress, or the service provider is still " & _
                         "processing a callback function."
        Case WSAEFAULT
            strMessage = "The name parameter is not a valid part of " & _
                         "the user address space."
        Case WSAEINTR
            strMessage = "A blocking Windows Socket 1.1 call was " & _
                         "canceled through WSACancelBlockingCall."
    End Select
    '
    MsgBox strMessage, vbExclamation
    '
End Sub