Visual Basic WorkShop

URL Info,

VBO Ad



      URLInfo is a complete Internet application (with VB source code) which is using winsock functions and types (structures) directly, without any ocx (winsock.ocx). The goals of the program are:

      The program looks like this:
      How to use the program? You can give a named address, dotted numeric or even a numeric address in the right textbox and then press <Enter>. If you give any of these three forms you will have the other ways of the addresses. Then you can execute a ping operation to the address or even to give extra informations, stored at NIC, regarding this address. Also you can navigate to the address.

      And now we'll delve into the source code of the program. I'm using a single form (frmMain) which is containing all the declarations, functions and controls. There are declarations of the functions declared from "wsock32.dll" and constants and types structures used by these functions. 

Private Const IP_STATUS_BASE As Long = 11000
Private Const IP_SUCCESS As Long = 0
Private Const IP_BUF_TOO_SMALL As Long = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE As Long = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE As Long = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE As Long = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE As Long = (11000 + 5)
Private Const IP_NO_RESOURCES As Long = (11000 + 6)
Private Const IP_BAD_OPTION As Long = (11000 + 7)
Private Const IP_HW_ERROR As Long = (11000 + 8)
Private Const IP_PACKET_TOO_BIG As Long = (11000 + 9)
Private Const IP_REQ_TIMED_OUT As Long = (11000 + 10)
Private Const IP_BAD_REQ As Long = (11000 + 11)
Private Const IP_BAD_ROUTE As Long = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT As Long = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM As Long = (11000 + 14)
Private Const IP_PARAM_PROBLEM As Long = (11000 + 15)
Private Const IP_SOURCE_QUENCH As Long = (11000 + 16)
Private Const IP_OPTION_TOO_BIG As Long = (11000 + 17)
Private Const IP_BAD_DESTINATION As Long = (11000 + 18)
Private Const IP_ADDR_DELETED As Long = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE As Long = (11000 + 20)
Private Const IP_MTU_CHANGE As Long = (11000 + 21)
Private Const IP_UNLOAD As Long = (11000 + 22)
Private Const IP_ADDR_ADDED As Long = (11000 + 23)
Private Const IP_GENERAL_FAILURE As Long = (11000 + 50)

Private Const MAX_IP_STATUS As Long = (11000 + 50)
Private Const IP_PENDING As Long = (11000 + 255)
Private Const PING_TIMEOUT As Long = 500
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const AF_Inet As Long = 2
Private Const SockStream As Long = 1

Private Const lWinsockVersion As Integer = 1

Private Type WSAData
    wVersion        As Integer
    wHighVersion    As Integer
    szDescription   As String * 257
    szSystemStatus  As String * 129
    iMaxSockets     As Integer
    iMaxUdpDg       As Long
    lpVendorInfo    As Long
End Type

Private Type Hostent
    h_name          As Long
    h_aliases       As Long
    h_addrtype      As Integer
    h_length        As Integer
    h_addr_list     As Long
End Type

Private Type SockAddr_In
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Private Type ICMP_OPTIONS
   Ttl             As Byte
   Tos             As Byte
   Flags           As Byte
   OptionsSize     As Byte
   OptionsData     As Long
End Type

Private Type ICMP_ECHO_REPLY
   Address         As Long
   status          As Long
   RoundTripTime   As Long
   DataSize        As Long
  'Reserved        As Integer
   DataPointer     As Long
   Options         As ICMP_OPTIONS
   Data            As String * 250
End Type


Private Declare Function WSAStartup Lib "wsock32.dll" ( _
    ByVal a As Long, b As WSAData) As Integer
Private Declare Function WSACleanup Lib "wsock32.dll" () As Integer
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Private Declare Function inet_addr Lib "wsock32" (ByVal cp As String) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long
Private Declare Function gethostbyaddr Lib "wsock32" _
    (addr As Long, ByVal nLen As Long, ByVal ntype As Long) As Long
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Integer
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Private Declare Function Socket Lib "wsock32.dll" Alias "socket" ( _
    ByVal af As Long, ByVal typesock As Long, ByVal protocol As Long) As Integer
Private Declare Function htons Lib "wsock32.dll" (ByVal a As Long) As Integer
Private Declare Function connect Lib "wsock32.dll" ( _
    ByVal sock As Long, sockstruct As SockAddr_In, ByVal structlen As Long) As Integer
Private Declare Function Send Lib "wsock32.dll" Alias "send" ( _
    ByVal sock As Long, ByVal msg As String, ByVal msglen As Long, _
    ByVal flag As Long) As Integer
Private Declare Function recv Lib "wsock32.dll" ( _
    ByVal sock As Long, ByVal msg As String, ByVal msglen As Long, _
    ByVal flag As Long) As Integer
Private Declare Function closesocket Lib "wsock32.dll" (ByVal sock As Long) As Integer

Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
   (ByVal IcmpHandle As Long) As Long
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
   (ByVal IcmpHandle As Long, _
    ByVal DestinationAddress As Long, _
    ByVal RequestData As String, _
    ByVal RequestSize As Long, _
    ByVal RequestOptions As Long, _
    ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, _
    ByVal Timeout As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
	(ByVal hwnd As Long, ByVal lpOperation As String, _
	ByVal lpFile As String, ByVal lpParameters As String, _
	ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Const SW_MAXIMIZE = 3
      The last 2 function doesn't pertain to winsock library but they are used into the program. Many parameters or type members are pointers (the addresses of a variable) and as we know VB haven't functions to handle pointers. All the job can be made using RtlMoveMemory function from Kernel32.dll, in a pretty unorthodox way. Also, there are some declarations from "icmp.dll" used for pinging the site. The constants which start "IP_" are need for results codes from ping function.

      First, let's look what the URL format means and how to convert it. Unless you own your own web site with its own domain name, you may not realize that all Web addresses really are numeric: when a web site is created, it's normally listed with a special "registrar" who is authorized to run a Domain Name Server. This server contains a huge lookup table that associates a normal-sounding name with the web site's true numeric address.

      For example, http://www.yahoo.com is really site number "209.238.38.127." If you click on http://209.238.38.127 (or enter in your browser's address line), you'll still go to yahoo.com exactly the same as if you'd clicked on http://www.yahoo.com . The more familiar URL format (www.yahoo.com) is really nothing more than an alias provided solely for human convenience, because it's much easier to remember than a string of numbers.

      But it's the numbers that matter: When you enter or click on a URL like www.yahoo.com, your browser actually asks a Domain Name Server for the real numeric address of the site, and then uses the numeric address to find the page you want. (By the way: Now you know what your browser means when it gives you a "DNS Not Found" error: It couldn't find the correct Domain Name Server, or couldn't find the correct site entry within the server, and thus didn't know how to find the site you were looking for.)

      With a bit of deep-geek manipulation, those numeric addresses can be converted into a variety of formats. For example, the four groups of three digits in a site's real numeric address are based on powers of 256; from left to right, each group of digits represents itself times 256 to the zero, first, second, and third, respectively .

      I'll do the math for you, but you can see that Yahoo.Com's "216.32.74.55" address can be expanded into 216*16777216 + 32*65536 + 74*256+ 55, and that adds up to 3625994807. And in fact, http:// 3625994807/ also gets you to Yahoo.Com.

      But there's still more: If you're looking for real obscurity the human-friendly decimal (base ten) digits also can be translated into their computer-friendly hexadecimal (base 16) equivalents; and the numbers and punctuation also can be represented as ASCII computer code. Thus, http://www.yahoo.com can be shown in all these ways, which function identically, and bring you to exactly the same place:

     Your browser is perfectly happy with any of these representations of the address because under the covers, all six URLs are actually identical!

      For these conversions there are some functions: 

Private Function Convert1(s As String) As String
On Error Resume Next
If s = "" Then Exit Function
Dim a() As String
a = Split(s, ".")
If UBound(a) <> 3 Then
    MsgBox "Address incorrect format (xxx.xxx.xxx.xxx)", , "Error"
Else
    Convert1 = CDbl(a(3)) + CDbl(a(2)) * 256 + CDbl(a(1)) * 65536 + CDbl(a(0)) * 16777216
End If
End Function

Private Function Convert2(s As String) As String
On Error Resume Next
If s = "" Then Exit Function
Dim d As Double, dd As Double, sTmp As String
d = CDbl(s)
dd = CInt(d / 16777216 - 0.99999)
sTmp = CStr(dd)
d = d - dd * 16777216
sTmp = sTmp & "." & CStr(d \ 65536)
d = d Mod 65536
sTmp = sTmp & "." & CStr(d \ 256)
sTmp = sTmp & "." & CStr(d Mod 256)
Convert2 = sTmp
End Function

Private Function Encode(s As String) As String
Dim sTmp As String
Dim i As Long
For i = 1 To Len(s)
sTmp = sTmp & "%" & Right$("00" & Hex$(Asc(Mid$(s, i, 1))), 2)
Next
Encode = sTmp
End Function
      At the same time there is another operation: if we have one form of an address to get the others. So, we get IP address from a named address (GetIP function) or backward, to get named address from a IP address (GetURL function). These functions are based on the gethostbyname and gethostbyaddr functions of winsock library. The code is following: 
Private Function GetIP(sAddr As String)
On Error GoTo Done:
Dim tWSAData As WSAData
Dim Host As Hostent
Dim NSInfo As Long
Dim addr As Long, addr2 As Long
Dim ErrCode As Long
Dim strIP As String
Dim cName() As Byte

If WSAStartup(lWinsockVersion, tWSAData) Then
Err.Raise vbObjectError + 1000, "Error calling WSAStartup "
GoTo Done
End If

NSInfo = gethostbyname(sAddr)

If NSInfo <> 0 Then
    CopyMemory Host, ByVal NSInfo, LenB(Host)
    If Host.h_addr_list <> 0 Then
        CopyMemory addr, ByVal Host.h_addr_list, 4
        CopyMemory addr, ByVal addr, 4
        addr2 = inet_ntoa(addr)
        ReDim cName(lstrlen(addr2) * 2)
        CopyMemory cName(0), ByVal addr2, lstrlen(addr2) * 2
        strIP = StrConv(cName, vbUnicode)
        If InStr(strIP, Chr(0)) > 0 Then
            GetIP = Left(strIP, InStr(strIP, Chr(0)) - 1)
        Else
            GetIP = strIP
        End If
    End If
End If
Done:
On Error Resume Next
WSACleanup
End Function

Function GetURL(IPAddr As String) As String
Dim tWSAData As WSAData
Dim Host As Hostent
Dim NSInfo As Long
Dim addr As Long
Dim ErrCode As Long
Dim strName As String
Dim cName() As Byte

If WSAStartup(lWinsockVersion, tWSAData) Then
Err.Raise vbObjectError + 1000, "Error calling WSAStartup "
GoTo Done
End If

addr = inet_addr(IPAddr)
NSInfo = gethostbyaddr(addr, 4, AF_Inet)
If NSInfo <> 0 Then
    CopyMemory Host, ByVal NSInfo, LenB(Host)
    ReDim cName(lstrlen(Host.h_name) * 2)
    CopyMemory cName(0), ByVal Host.h_name, lstrlen(Host.h_name) * 2
    strName = StrConv(cName, vbUnicode)
    If InStr(strName, Chr(0)) > 0 Then
        GetURL = Left(strName, InStr(strName, Chr(0)) - 1)
    Else
        GetURL = strName
    End If
End If
Done:
On Error Resume Next
 WSACleanup
End Function
     First of all, we need to start winsock library using WSAStartup function. Then call the gethostbyname or gethostbyaddr functions and interpret the results. But because the results are pointers (memory addresses of the variables or structures) we are using CopyMemory (RtlMoveMemory) function to convert these results. I can't explain here all the functions from winsock library, but there are good sources for this. Finally, we are unloading winsock library by using WSACleanup function.

      I guess you already knows what ping is: a way to check if a computer is online or not (using TCP/IP). This operation is made by our program for current address, calling "Ping" function with an ICMP_ECHO_REPLY structure (type) as parameter. The result is interpreted by StatusCode function. Here you are "Ping" function (for address from txtAddrNo1 text-box): 

Private Function Ping(Echo As ICMP_ECHO_REPLY) As Long
   On Error Resume Next
   Dim addr As Long
   Dim hPort As Long
   hPort = IcmpCreateFile()
   If hPort Then
       addr = inet_addr(txtAddrNo1)
       IcmpSendEcho hPort, addr, "test", _
              4, 0, Echo, Len(Echo), PING_TIMEOUT
       Ping = Echo.status
       IcmpCloseHandle hPort
   End If
End Function
     Finally, we get informations regarding a site by querying a whois database. The informations are: registrar name and address, his email, phone and fax, his DNS servers address and other related informations. For achieving this we need a function to get web pages using HTTP protocol on the Internet. The code for getting a page over the Internet using winsock library is following: 
Private Function GetHTTP(IPAddr As String, page As String) As String
Dim tWSAData As WSAData
Dim udtSocket As SockAddr_In
Dim lSocket As Long, lSize As Long
Dim sResult As String, sBuffer As String * 2048
Dim sCommand As String

If WSAStartup(lWinsockVersion, tWSAData) Then
Err.Raise vbObjectError + 1000, "Error calling WSAStartup "
GoTo Done
End If

lSocket = Socket(AF_Inet, SockStream, 0)

If lSocket > 0 Then
    With udtSocket
    .sin_family = AF_Inet
    .sin_addr = inet_addr(IPAddr)
    .sin_port = htons(80)
    .sin_zero = String$(8, 0)
    End With
    
    If connect(lSocket, udtSocket, CLng(Len(udtSocket))) Then
    Err.Raise vbObjectError + 10001, , "Connect failure"
    GoTo Done
    End If
    
    sCommand = "GET " & page & " HTTP/1.0" & vbCrLf & vbCrLf
    If Send(lSocket, sCommand, Len(sCommand), 0) <> Len(sCommand) Then
    Err.Raise vbObjectError + 10002, "Send failure"
    GoTo Done
    End If

    sBuffer = String$(2048, 0)
    Do While True
    lSize = recv(lSocket, sBuffer, Len(sBuffer), 0)
    If lSize < 1 Then Exit Do
    sResult = sResult & Left$(sBuffer, lSize)
    Loop
    
    GetHTTP = sResult
End If
Done:
On Error Resume Next
closesocket lSocket
WSACleanup
End Function
      Then, the result from web page is parsed and displayed into a text-box.

      You can download all the project from here (40,6 kb).

© VB Work 2000, Last update