[Visual basic] Сканнируем порты Excel'ем

Discussion in 'PHP' started by <Cyber-punk>, 7 Sep 2010.

  1. <Cyber-punk>

    <Cyber-punk> Smash the Stack

    Joined:
    1 Oct 2009
    Messages:
    658
    Likes Received:
    315
    Reputations:
    430
    Представьте себе, нудный офис, старенький комп, с ограниченными возможностями.
    Посторонний софт ставить нелзя, а из установленного только Microsoft Office.
    А нам по зарез нужно просканить порты на одном из серверов.
    Чтож, возьмём обычный Excel. Мы всегда забываем, что есть такая прекрасная штука, как Макросы.
    Напишем простенький сканнер портов:

    Code:
    Option Explicit
    
    Public Const INADDR_ANY = 0&
    Public Const INADDR_LOOPBACK = &H7F000001
    Public Const INADDR_BROADCAST = &HFFFFFFFF
    Public Const INADDR_NONE = &HFFFFFFFF
    Public Const ADDR_ANY = INADDR_ANY
    
    Public Const AF_INET = 2
    
    Public Const SOCK_STREAM = 1&
    
    Public Const ERROR_SUCCESS = 0
    
    Public Const FIONBIO = &H8004667E
    
    Public Const SOL_SOCKET = &HFFFF
    
    Public Const SO_ERROR = &H1007
    
    Public Type in_addr
      s_addr              As Long
    End Type
    
    Public Const WSAPROTOCOL_LEN = 255&
    Public Const MAX_PROTOCOL_CHAIN = 7&
    
    Public Type GUID
      Data1 As Long
      Data2 As Integer
      Data3 As Integer
      Data4(7) As Byte
    End Type
    
    Type WSAPROTOCOLCHAIN
      ChainLen            As Long
                                              
                                              
                                              
      ChainEntries(1 To MAX_PROTOCOL_CHAIN) As Long
    End Type
    
    
    Type WSAPROTOCOL_INFO
      dwServiceFlags1     As Long
      dwServiceFlags2     As Long
      dwServiceFlags3     As Long
      dwServiceFlags4     As Long
      dwProviderFlags     As Long
      ProviderId          As GUID
      dwCatalogEntryId    As Long
      ProtocolChain       As WSAPROTOCOLCHAIN
      iVersion            As Long
      iAddressFamily      As Long
      iMaxSockAddr        As Long
      iMinSockAddr        As Long
      iSocketType         As Long
      iProtocol           As Long
      iProtocolMaxOffset  As Long
      iNetworkByteOrder   As Long
      iSecurityScheme     As Long
      dwMessageSize       As Long
      dwProviderReserved  As Long
      szProtocol(1 To WSAPROTOCOL_LEN + 1) As Byte
    End Type
    
    Type ScanPort
    
        nSocket As Long
        nPort As Long
        
    End Type
    
    Public Const MIN_SOCKETS_REQD As Long = 1
    Public Const WS_VERSION_REQD As Long = &H101
    Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
    Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
    Public Const SOCKET_ERROR As Long = -1
    Public Const WSADESCRIPTION_LEN = 257
    Public Const WSASYS_STATUS_LEN = 129
    Public Const MAX_WSADescription = 256
    Public Const MAX_WSASYSStatus = 128
    Public Type WSAData
        wVersion As Integer
        wHighVersion As Integer
        szDescription(0 To MAX_WSADescription) As Byte
        szSystemStatus(0 To MAX_WSASYSStatus) As Byte
        wMaxSockets As Integer
        wMaxUDPDG As Integer
        dwVendorInfo As Long
    End Type
    Type WSADataInfo
        wVersion As Integer
        wHighVersion As Integer
        szDescription As String * WSADESCRIPTION_LEN
        szSystemStatus As String * WSASYS_STATUS_LEN
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As String
    End Type
    Public Type HOSTENT
        hName As Long
        hAliases As Long
        hAddrType As Integer
        hLen As Integer
        hAddrList As Long
    End Type
    
    Public Type sockaddr_in
      sin_family          As Integer
      sin_port            As Integer
      sin_addr            As in_addr
      sin_zero(7)         As Byte
    End Type
    
    Rem Declare Function WSAStartupInfo Lib "WSOCK32" Alias "WSAStartup" (ByVal wVersionRequested As Integer, lpWSADATA As WSADataInfo) As Long
    Declare Function WSACleanup Lib "WSOCK32" () As Long
    Declare Function WSAGetLastError Lib "WSOCK32" () As Long
    Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
    Public Declare Function Socket Lib "wsock32.dll" _
      Alias "socket" (ByVal af As Long, ByVal sockettype As Long, ByVal Protocol As Long) As Long
    Public Declare Function htons Lib "wsock32.dll" _
      (ByVal hostshort As Long) As Integer
    Public Declare Function inet_addr Lib "wsock32.dll" _
      (ByVal cp As String) As Long
    Public Declare Function Connect Lib "wsock32.dll" _
      Alias "connect" (ByVal s As Long, nameaddr As Any, ByVal namelen As Long) As Long
    Public Declare Function WSASocket Lib "wsock32.dll" _
      (ByVal af As Long, _
       ByVal addr_type As Long, _
       ByVal Protocol As Long, _
       lpProtocolInfo As WSAPROTOCOL_INFO, _
       ByVal reserved As Long, _
       ByVal dwFlags As Long) As Long
       
       Public Declare Function CloseSocket Lib "wsock32.dll" _
      Alias "closesocket" (ByVal s As Long) As Long
      
      Public Declare Function ioctlsocket Lib "wsock32.dll" _
      (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
      
    Public Declare Function recv Lib "wsock32.dll" _
      (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal Flags As Long) As Long
    
    Public Declare Function getsockopt Lib "wsock32.dll" _
      (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
      
    Public Declare Function send Lib "wsock32.dll" _
      (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal Flags As Long) As Long
    
    
      
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    
    
    
    
    
    
    
    Public Function HiByte(ByVal wParam As Integer)
        HiByte = wParam \ &H100 And &HFF&
    End Function
    Public Function LoByte(ByVal wParam As Integer)
        LoByte = wParam And &HFF&
    End Function
    
    
    Public Function SocketsInitialize() As Boolean
        Dim WSAD As WSAData
        Dim sLoByte As String
        Dim sHiByte As String
        If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
            MsgBox "The 32-bit Windows Socket is not responding."
            SocketsInitialize = False
            Exit Function
        End If
        If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
            MsgBox "This application requires a minimum of " & _
            CStr(MIN_SOCKETS_REQD) & " supported sockets."
            SocketsInitialize = False
            Exit Function
        End If
        If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
            sHiByte = CStr(HiByte(WSAD.wVersion))
            sLoByte = CStr(LoByte(WSAD.wVersion))
            MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
            SocketsInitialize = False
            Exit Function
        End If
        SocketsInitialize = True
    End Function
    
    Public Sub SocketsCleanup()
        If WSACleanup() <> ERROR_SUCCESS Then
            MsgBox "Socket error occurred in Cleanup."
        End If
    End Sub
    
    
    Sub portscan()
        Dim addr_in As sockaddr_in
        Dim nSocket As Integer
        Dim nRet As Integer
        Dim nPorts As Integer
        Dim nRow As Integer
        Dim Buf As String
        Dim naSockets() As ScanPort
        Dim nMaxSockets, nCounter
        Dim sHost As String
        Dim nTimeOut As Integer
        Dim nStart As Long
        Dim nEnd As Long
                             
        nRow = 1
        nMaxSockets = 20
        SocketsInitialize
    
        nStart = Sheet2.Cells(2, 2)
        nEnd = Sheet2.Cells(2, 3)
    
        sHost = Sheet2.Cells(3, 2)
        nTimeOut = Sheet2.Cells(4, 2)
        nMaxSockets = Sheet2.Cells(5, 2)
    
        ReDim naSockets(nMaxSockets)
        
        Sheets.Add , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = sHost
    
        While nPorts < nEnd
                
            For nSocket = 0 To nMaxSockets
            
                addr_in.sin_family = AF_INET
                addr_in.sin_port = htons(nStart + nPorts)
                addr_in.sin_addr.s_addr = inet_addr(sHost)
    
                naSockets(nSocket).nSocket = Socket(AF_INET, SOCK_STREAM, 6)
                naSockets(nSocket).nPort = nStart + nPorts
                        
                If (ioctlsocket(naSockets(nSocket).nSocket, FIONBIO, 1) <> 0) Then
                    Debug.Print "Failed to set non-blocking"
                End If
                    
                nRet = Connect(naSockets(nSocket).nSocket, addr_in, Len(addr_in))
                nPorts = nPorts + 1
                
            Next
                    
            Sleep (nTimeOut)
                          
            For nSocket = 0 To nMaxSockets
            
                nRet = send(naSockets(nSocket).nSocket, Buf, 0, 0)
                        
                If (nRet = 0) Then
                    Sheets(Sheets.Count).Cells(nRow, 1) = CStr(naSockets(nSocket).nPort)
                    Sheets(Sheets.Count).Cells(nRow, 2) = "Open"
                    nRow = nRow + 1
                End If
                    
            
                CloseSocket (naSockets(nSocket).nSocket)
            
            Next
                
        Wend
    
        SocketsCleanup
    
        MsgBox "Success!"
        MsgBox "This program created by <cyber-punk>."
    
    End Sub
    [​IMG]

    Автор - я!

    Вот весь xlt-файл вместе c макросами :
    Скачать
     
    _________________________
    #1 <Cyber-punk>, 7 Sep 2010
    Last edited: 7 Sep 2010
  2. Vid0k

    Vid0k Elder - Старейшина

    Joined:
    24 Dec 2007
    Messages:
    393
    Likes Received:
    125
    Reputations:
    13
    авторство чьйЁ?
     
  3. Welemir

    Welemir Elder - Старейшина

    Joined:
    10 Jan 2008
    Messages:
    229
    Likes Received:
    11
    Reputations:
    -4
    WinSock рулит:).Спасибо автору - возможно,пригодится в ближайшем будущем : )
     
    1 person likes this.
  4. <Cyber-punk>

    <Cyber-punk> Smash the Stack

    Joined:
    1 Oct 2009
    Messages:
    658
    Likes Received:
    315
    Reputations:
    430
    Моё!
     
    _________________________