Программа по определению IP адреса сайта – исходный код на языке Visual Basic

Сегодня мы напишем программу на языке Visual Basic, которая умеет определять ip адрес сайта по его названию (домену), а также проверять подключен ли Интернет на компьютере

Писать программу мы будем в среде программирования Microsoft Visual Basic 6.0. Итак, начнем, запустим среду, создадим стандартный проект и добавляем 3 кнопки (CommandButton) и одно текстовое поле (TextBox). Затем задайте в окне свойств названия объектов в поле caption:

• Command1 = Узнать IP Сайта
• Command2 = Включен ли Интернет
• Command3 = Выход
• TextBox (поле text) = www.yandex.ru

Исходный код программы на языке Visual Basic

Теперь перейдем к коду, для начала в код формы вставьте следующие:

Private Declare Function RasEnumConnections Lib _
        "RasApi32.dll" Alias "RasEnumConnectionsA" _
        (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
        Private Declare Function RasGetConnectStatus Lib _
        "RasApi32.dll" Alias "RasGetConnectStatusA" _
        (ByVal hRasCon As Long, lpStatus As Any) As Long
        Private Const RAS95_MaxEntryName = 256
        Private Const RAS95_MaxDeviceType = 16
        Private Const RAS95_MaxDeviceName = 32
Private Type RASCONN95
        dwSize As Long
        hRasCon As Long
        szEntryName(RAS95_MaxEntryName) As Byte
        szDeviceType(RAS95_MaxDeviceType) As Byte
        szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Private Type RASCONNSTATUS95
        dwSize As Long
        RasConnState As Long
        dwError As Long
        szDeviceType(RAS95_MaxDeviceType) As Byte
        szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Public Function IsConnected() As Boolean
        Dim TRasCon(255) As RASCONN95
        Dim lg As Long
        Dim lpcon As Long
        Dim RetVal As Long
        Dim Tstatus As RASCONNSTATUS95
        TRasCon(0).dwSize = 412
        lg = 256 * TRasCon(0).dwSize
        RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
        Tstatus.dwSize = 160
        RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
        If Tstatus.RasConnState = &H2000 Then
                IsConnected = True
        Else
                IsConnected = False
        End If
End Function
Private Sub Command1_Click()
        WinsockInit
        MsgBox "IP Адрес сайта:" & HostByName(Text1.Text)
        WSACleanUp
End Sub

Private Sub Command2_Click()
        'если есть соединение, то IsConnected() = True, иначе False
        Select Case IsConnected()
                Case False
                MsgBox "Интернет не подключен"
                Case True
                MsgBox "Интернет включен"
        End Select
End Sub

Private Sub Command3_Click()
        End
End Sub

Здесь мы с Вами используем API функции Visual Basic, а в коде Command1 указанно, что при нажатии на эту кнопку будет появляться сообщение с ip адресом сайта. В коде Command2 проверяется, подключен ли Интернет и также выводится соответствующее сообщение. А в коде Command3 просто завершаем нашу программу, т.е. при нажатии произойдет выход. Но с кодом еще не все, Вам теперь нужно добавить модуль через меню «Проект ->добавить модуль» и вставить в него следующий код:

Option Explicit
        Public Const SOCKET_ERROR = -1
        Public Const AF_INET = 2
        Public Const PF_INET = AF_INET
        Public Const MAXGETHOSTSTRUCT = 1024
        Public Const SOCK_STREAM = 1
        Public Const MSG_PEEK = 2
Private Type SockAddr
        sin_family As Integer
        sin_port As Integer
        sin_addr As String * 4
        sin_zero As String * 8
End Type
Private Type T_WSA
        wVersion As Integer
        wHighVersion As Integer
        szDescription(0 To 255) As Byte
        szSystemStatus(0 To 128) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As Long
End Type
        Dim WSAData As T_WSA
        Type Inet_Address
        Byte4 As String * 1
        Byte3 As String * 1
        Byte2 As String * 1
        Byte1 As String * 1
        End Type
        Public IPStruct As Inet_Address
Public Type T_Host
        h_name As Long
        h_aliases As Long
        h_addrtype As Integer
        h_length As Integer
        h_addr_list As Long
End Type
        Declare Sub CopyMemory Lib "kernel32.dll" Alias _
        "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
        Declare Function gethostbyaddr Lib "wsock32.dll" _
        (addr As Long, ByVal addr_len As Long, _
        ByVal addr_type As Long) As Long
        Declare Function inet_addr Lib "wsock32.dll" _
        (ByVal addr As String) As Long
        Declare Function GetHostByName Lib _
        "wsock32.dll" Alias "gethostbyname" _
        (ByVal HostName As String) As Long
        Declare Function GetHostName Lib _
        "wsock32.dll" Alias "gethostname" _
        (ByVal HostName As String, HostLen As Long) As Long
        Declare Function WSAStartup Lib "wsock32.dll" _
        (ByVal a As Long, b As T_WSA) As Long
        Declare Function WSACleanUp Lib _
        "wsock32.dll" Alias "WSACleanup" () As Integer
Function HostByName(sHost As String) As String
        Dim s As String
        Dim p As Long
        Dim Host As T_Host
        Dim ListAddress As Long
        Dim ListAddr As Long
        Dim Address As Long
        s = String(64, 0)
        p = GetHostByName(sHost)
        If p = SOCKET_ERROR Then
                Exit Function
        Else
                If p 0 Then
                        CopyMemory Host.h_name, ByVal p, Len(Host)
                        ListAddress = Host.h_addr_list
                        CopyMemory ListAddr, ByVal ListAddress, 4
                        CopyMemory Address, ByVal ListAddr, 4
                        HostByName = InetAddrLongToString(Address)
                Else
                        HostByName = "Ошибка DNS "
                End If
        End If
End Function

Private Function InetAddrLongToString(Address As Long) As String
        CopyMemory IPStruct, Address, 4
        InetAddrLongToString = CStr(Asc(IPStruct.Byte4)) + "." + CStr(Asc(IPStruct.Byte3)) _
        + "." + CStr(Asc(IPStruct.Byte2)) + "." + CStr(Asc(IPStruct.Byte1))
End Function

Function HostByAddress(ByVal sAddress As String) As String
        Dim lAddress As Long
        Dim p As Long
        Dim HostName As String
        Dim Host As T_Host
        lAddress = inet_addr(sAddress)
        p = gethostbyaddr(lAddress, 4, PF_INET)
        If p 0 Then
                CopyMemory Host, ByVal p, Len(Host)
                HostName = String(256, 0)
                CopyMemory ByVal HostName, ByVal Host.h_name, 256
                If HostName = "" Then HostByAddress = "Unable to Resolve Address"
                        HostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)
                Else
                        HostByAddress = "Ошибка DNS "
        End If
End Function

Public Sub WinsockInit()
        WSAStartup &H101, WSAData
End Sub

Вот теперь Вы можете запустить проект и проверить работоспособность программы, а затем и скомпилировать ее.

На этом все, пока!