(c) 2002 Visual Studio Magazine 
Fawcette Technical Publications

Issue: March 2002
Section: Q&A
Authors: Teixeira, Peterson

VB4/32, VB5, VB6		Put a Name on That Number
Listing 1	It appears that Windows uses the same algorithm for two registration APIs: RegisterClipboardFormat and RegisterWindowMessage. Both APIs generate unique IDs for items that need to be shared globally with other applications, so this makes sense. You can further confirm this observation by calling GetClipboardFormatName against known registered window message values.

' *******************************************
'  Algorithm inspired by Eduardo A. Morcillo 
'  who posted the requisite clues on 
'  news://news.devx.com/vb.api, 19 May 2000.
' *******************************************
Option Explicit

' Win32 API Declarations
Private Declare Function GetClipboardFormatName _
	Lib "user32" Alias "GetClipboardFormatNameA" _
	(ByVal wFormat As Long, ByVal lpString As _
	String, ByVal nMaxCount As Long) As Long
Private Declare Function RegisterWindowMessage _
	Lib "user32" Alias "RegisterWindowMessageA" _
	(ByVal lpString As String) As Long

' Useful constants
Private Const MIN_REGMSG As Long = &HC000&
Private Const MAX_REGMSG As Long = &HFFFF&

Public Function RegisterMessage(ByVal MsgName _
	As String) As Long
	' This will simply return the existing value
	' if this string is already registered.
	RegisterMessage = _
		RegisterWindowMessage(MsgName)
End Function

Public Function RegisteredMessageName(ByVal _
	MsgNumber As Long) As String
	Dim Buffer As String
	Dim nRet As Long
	Const BufLen = 256

	' Check for message with this number,
	' using adequately sized buffer.
	Buffer = String$(BufLen, 0)
	nRet = GetClipboardFormatName( _
		MsgNumber, Buffer, BufLen)
	' Return value is number of characters
	' placed in buffer.
	If nRet Then
		RegisteredMessageName = Left$(Buffer, nRet)
	End If
End Function

Public Function RegisteredMessageNumber( _
	ByVal MsgName As String) As Long
	Dim i As Long
	Dim Buffer As String
	Dim nRet As Long
	Const BufLen = 256

	' Could just call RegisterWindowMessage, but
	' that will actually register this string if
	' it isn't already registered. So, it's best
	' to loop through all possible values, using
	' an adequately sized buffer, and doing a
	' case-insensitive compare against each entry.
	Buffer = String$(BufLen, 0)
	MsgName = UCase$(Trim$(MsgName))
	For i = MIN_REGMSG To MAX_REGMSG
		nRet = GetClipboardFormatName( _
			i, Buffer, BufLen)
		If nRet Then
			If UCase$(Left$(Buffer, nRet)) = _
				MsgName Then
				' Assign results, and return.
				RegisteredMessageNumber = i
				Exit For
			End If
		End If
	Next i
End Function


VB.NET	Emulate Ping Functionality
Listing 2	Here's how to create a socket for an ICMP Echo message, fill Echo message data, send a message, and retrieve a response

Option Strict On
Option Explicit On 

Imports System.Net
Imports System.Net.Sockets

Public Enum ICMPType
	EchoReply = 0
	Unreachable = 3
	Echo = 8
End Enum

' --- ICMP Echo Header Format --- 
' (first 8 bytes of the data buffer)

' Buffer (0) ICMP Type Field
' Buffer (1) ICMP Code Field  
'     (must be 0 for Echo and Echo Reply)
' Buffer (2) checksum hi 
'     (must be 0 before checksum calc)
' Buffer (3) checksum lo 
'     (must be 0 before checksum calc)
' Buffer (4) ID hi
' Buffer (5) ID lo
' Buffer (6) sequence hi
' Buffer (7) sequence lo
' Buffer (8)..(n)  Ping Data

Module Module1
	Private Const portICMP As Integer = 7
	Private Const bufferHeaderSize As Integer = 8
	Private Const packageHeaderSize As Integer _
		= 28

	Sub Main()
		Dim hostName As String
		Console.Write( _
			"Enter Remote Host Name or IP: ")
		hostName = Console.ReadLine()
		Echo(hostName)
		Console.WriteLine("Press 'Enter' to exit.")
		Console.ReadLine()
	End Sub

	Public Sub Echo(ByVal RemoteName As String)
		'address/port of remote host
		Dim RemoteHost As IPEndPoint

		'id of this packet
		Dim Identifier As Short = 0

		'sequence number of this packet
		Dim Sequence As Short = 0

		'number of bytes of data to send
		Dim DataSize As Byte = 32

		'the socket we use to connect and 
		'send data through
		Dim ICMPSocket As Socket

		'the request buffer
		Dim RequestBuffer() As Byte

		'the reply buffer
		Dim ReplyBuffer(255) As Byte

		'the number of bytes received
		Dim RecvSize As Integer = 0

		Try
			ICMPSocket = New _
				Socket(AddressFamily.InterNetwork, _
				SocketType.Raw, ProtocolType.Icmp)

			ICMPSocket.Blocking = False

			RemoteHost = _
				GetRemoteEndpoint(RemoteName)

			DataSize = Convert.ToByte(DataSize + _
				bufferHeaderSize)

			' If odd data size, we need to add 
			' one empty byte
			If (DataSize Mod 2 = 1) Then
				DataSize += Convert.ToByte(1)
			End If
			ReDim RequestBuffer(DataSize - 1)

			' Set Type Field
			RequestBuffer(0) = _
			Convert.ToByte(ICMPType.Echo)
			' Set ID Field
			BitConverter.GetBytes( _
				Identifier).CopyTo(RequestBuffer, 4)
			' Set Sequence Field
			BitConverter.GetBytes( _
				Sequence).CopyTo(RequestBuffer, 6)

			' load some data into buffer
			Dim i As Integer
			For i = 8 To DataSize - 1
				RequestBuffer(i) = _
				Convert.ToByte(i Mod 8)
			Next i

			' Set Checksum
			CreateChecksum(RequestBuffer, _
				DataSize, RequestBuffer(2), _
				RequestBuffer(3))

			ICMPSocket.SendTo(RequestBuffer, 0, _
				DataSize, SocketFlags.None, _
				RemoteHost)

			RecvSize = ICMPSocket.ReceiveFrom( _
				ReplyBuffer, SocketFlags.None, _
				CType(RemoteHost, EndPoint))

			If RecvSize > 0 Then
				Select Case ReplyBuffer(20)
					Case Convert.ToByte( _
						ICMPType.EchoReply)
						Console.WriteLine( _
							"Remote host " + _
							RemoteHost.Address. _
							ToString _
							+ " responded. " + _
							(RecvSize - _
							packageHeaderSize _
							).ToString() + _
							" bytes received.")
					Case Convert.ToByte( _
						ICMPType.Unreachable)
						Console.WriteLine( _
							"Remote endpoint " + _
							"unreachable.")
					Case Else
						Console.WriteLine( _
							"Received unexpected " _
							+ "data...")
					End Select
				End If

		Catch e As Exception
			Console.WriteLine("Error: " + _
				e.Message)
		Finally
			If Not ICMPSocket Is Nothing Then
				ICMPSocket.Close()
			End If
		End Try
	End Sub

	Public Function GetRemoteEndpoint(ByVal _
		RemoteAddress As String) As IPEndPoint
		Return New IPEndPoint( _
			Dns.Resolve( _
			RemoteAddress).AddressList(0) _
			, portICMP)
	End Function

	' ICMP requires a checksum that is the one's 
	' complement of the one's complement sum of 
	' all the 16-bit values in the data in the 
	' buffer.
	' Use this procedure to load the Checksum 
	' field of the buffer.
	' The Checksum Field (hi and lo bytes) must be 
	' zero before calling this procedure.
	Private Sub CreateChecksum(ByRef data() As _
		Byte, ByVal Size As Integer, ByRef HiByte _
		As Byte, ByRef LoByte As Byte)
		Dim i As Integer
		Dim chk As Integer = 0

		For i = 0 To Size - 1 Step 2
			chk += Convert.ToInt32(data(i) * _
				&H100 + data(i + 1))
		Next

		chk = Convert.ToInt32((chk And &HFFFF&) + _
			Fix(chk / &H10000&))
		chk += Convert.ToInt32(Fix(chk / &H10000&))
		chk = Not (chk)

		HiByte = Convert.ToByte((chk And &HFF00) _
			/ &H100)
		LoByte = Convert.ToByte(chk And &HFF)
	End Sub
End Module
