[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now


VB5 Simple Winsock Control question

Posted on 1998-10-13
Medium Priority
Last Modified: 2013-11-13
I recently setup a network and now the localhostip command pulls up the ip assigned to my ethernet card and not the ip on my dialup adapter, which is the ip I want...how can I remedy this?
Question by:ChrisK
  • 6
  • 3
  • 2
  • +1

Expert Comment

ID: 1439602
you must 'bind' the winsock control to the adapter you want to use. I think there is a 'Bind' method, can't remember, check the only docs.

Author Comment

ID: 1439603
I can't seem to find BIND in the help file.  Can you be a bit more specific?

Expert Comment

ID: 1439604
I'll have to check on it.... sorry
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!


Author Comment

ID: 1439605
LVL 13

Expert Comment

ID: 1439606
Change your network settings in the control panel. Bind your network to your dialup adapter iso your other one.

Author Comment

ID: 1439607
Sorry, that is not the answer.  The dialup adapter and the lan are 2 seperate things, and must stay that way.  I'm looking for code to solve this.


Expert Comment

ID: 1439608
You do need to bind the control, before invoking the Listen method. Syntax:

Winsock1.Bind Port, LocalIP
(EG: Winsock1.Bind 21, 123.456.789.123)

Where the LocalIP is the IP of your Dial-Up connection.

Author Comment

ID: 1439609
That is not the answer at all...in fact that isn't even correct syntax.  You can't hard code a static ip!  LocalIP pulls an ip address from somewhere...might be from the registry, might be through some api call to windows.  Either case windows stores more then 1 ip when you have a LAN and are connected to the net.  The lan ip's follow standard protocal such as, ...etc.  Those ip's need to be ignored.  It needs to grab the IP from the dialup adapter but it isn't.  So if LocalIP itself can't do it.  Then what about an API routine call specifically to the dial up adapter to return the ip???  There's definetly a way to do this....
LVL 13

Accepted Solution

Mirkwood earned 320 total points
ID: 1439610
OK, it took me some time. But I found the answer. And that for 60 points.

Goto this page and download vbWinsock.bas


Now you have implementations of
and GetHostByName
First call getHostName
and now call GetHostByName. This returns all IP addresses.

Author Comment

ID: 1439611
Wow...thanks for the effort.  I've been experimenting with these calls and it seems you are on the right, however I am unable to get it to spit back the correct ip.  I might just be doing something wrong though.  Can you show some simple example source that works (If you do I'll raise the point value higher) so I can get this straightened out?

LVL 13

Expert Comment

ID: 1439612
Option Explicit
Private Type ICMPReqOpt
  TTL As Byte ' time-to-live
  tos As Byte ' type-of-service
  flags As Byte ' see below
  optsize As Byte ' length of options string
  options As String ' use empty string (haven't figured this yet)
End Type
Private Type ICMPEchoReply
  Address(1 To 4) As Byte ' address of system responding
  status As Long ' error code
  triptime As Long ' time in milliseconds
  datasize As Integer ' buffer size
  reserved As Integer ' not used
  replydata As String ' buffer returned
  ipoptions As ICMPReqOpt ' options structure
End Type
' ICMP API calls
Private Declare Function IcmpCreateFile Lib "ICMP.DLL" () As Long
Private Declare Function IcmpCloseHandle Lib "ICMP.DLL" _
  (ByVal lngHandle As Long) As Integer
Private Declare Function IcmpSendEcho Lib "ICMP.DLL" _
  (ByVal lngHandle As Long, ByVal lIP As Long, _
  strData As String, ByVal intDataLen As Integer, _
  usrOpt As ICMPReqOpt, bytBuff As Byte, _
  ByVal lngRepLen As Long, ByVal lTimeOut As Long) As Long
Private Declare Function IcmpGetLastError Lib "wsock32.dll" _
  Alias "WSAGetLastError" () As Long
' ICMP error codes
Private Const ICMP_SUCCESS = 0
Private Const ICMP_BUFFER_TOO_SMALL = 11001
Private Const ICMP_NET_UNREACHABLE = 11002
Private Const ICMP_HOST_UNREACHABLE = 11003
Private Const ICMP_NO_RESOURCES = 11006
Private Const ICMP_BAD_OPTION = 11007
Private Const ICMP_HW_ERROR = 11008
Private Const ICMP_PACKET_TOO_BIG = 11009
Private Const ICMP_REQ_TIMED_OUT = 11010
Private Const ICMP_BAD_REQ = 11011
Private Const ICMP_BAD_ROUTE = 11012
Private Const ICMP_TTL_EXPIRED_REASSEM = 11014
Private Const ICMP_PARAM_PROBLEM = 11015
Private Const ICMP_SOURCE_QUENCH = 11016
Private Const ICMP_OPTION_TOO_BIG = 11017
Private Const ICMP_BAD_DESTINATION = 11018
Private Const ICMP_ADDRESS_DELETED = 11019
Private Const ICMP_SPEC_MTU_CHANGE = 11020
Private Const ICMP_MTU_CHANGE = 11021
Private Const ICMP_UNLOAD = 11022
Private Const ICMP_GENERAL_FAILURE = 11050
Private Const ICMP_PENDING = 11255
' ICMP flags
' ICMP type-of-service options
Private Const ICMP_ECHO_REQUEST = 7
Private Const ICMP_END_OF_LIST = 0
Private Const ICMP_SECURITY = 1
Private Const ICMP_RECORD_ROUTE = &H89
Private Const ICMP_TIMESTAMP = 7
Private Const ICMP_STREAM_id = &H44
Private Const ICMP_NOOP = &H88
' we also need some basic Winsock stuff
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
Private Const AF_INET = 2

Private Type WSADATA
  wversion As Integer
  whighversion As Integer
  szDescription(0 To WSADescription_Len) As Byte
  szSystemStatus(0 To WSASYS_Status_Len) As Byte
  imaxsockets As Integer
  imaxudp As Integer
  lpszvenderinfo As Long
End Type
Private Declare Function gethostname Lib "wsock32.dll" _
  (ByVal hostname As String, ByVal nbytes As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" _
  (ByVal hostname As String) As Long
Private Declare Function gethostbyaddr Lib "wsock32.dll" _
  (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" _
  (ByVal VersionReq As Long, WSADataReturn As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
' and a way to copy memory directly...
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nbytes As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
  (lpString As Any) As Long
' finally, we need a handle for ICMP
Private hICMP As Long

Private Function TextToIP(ByVal IPAddress As String) As Long
Dim x As Integer ' scratch
Dim iOctet As Integer ' octet value
Dim bytIP(1 To 4) As Byte ' temp IP storage
Dim lIP As Long ' IP value
Dim iDots As Integer ' count of dots found
lIP = 0
iOctet = 0
iDots = 0
For x = 1 To Len(IPAddress)
  If Mid$(IPAddress, x, 1) = "." Then
    iDots = iDots + 1
    If iDots > 3 Then Exit For ' bad format!
    bytIP(iDots) = iOctet
    iOctet = 0
    ' add digit but restrict to 8 bits
    iOctet = (iOctet * 10 + Val("0" & Mid$(IPAddress, x, 1))) And 255
  End If
Next 'x
bytIP(4) = iOctet ' save last one
CopyMemory lIP, bytIP(1), 4 ' copy to LONG value
TextToIP = lIP ' copy to return value
End Function

Private Function IPToText(ByVal IPAddress As String) As String
IPToText = CStr(Asc(IPAddress)) & "." & _
    CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
    CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
    CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function

Private Function MyHostName() As String
Dim sTemp As String
Dim x As Long
sTemp = Space$(256)
x = gethostname(sTemp, Len(sTemp))
x = InStr(sTemp, vbNullChar)
If x > 0 Then sTemp = Left$(sTemp, x - 1)
MyHostName = sTemp
End Function

Function NameLookup(ByVal LookupName As String) As String
' routine to convert hostname to IP
' this routine actually gets all known aliases
' and IP addresses but only returns the first IP
Dim x As Long ' scratch
Dim nbytes As Long
Dim sTarget As String ' null-delimited hostname
Dim lHostent As Long ' address of hostent structure
Dim lHEName As Long ' address of name pointer
Dim lHEAlias As Long ' address of alias pointer
Dim lHEAddress As Long ' address of address pointer
Dim lIPPointer As Long ' address of IP address
Dim lAPointer As Long ' address of Alias

Dim iAliasCount As Long
Dim iAddressCount As Long
Dim sIP() As String
Dim sAlias() As String
Dim sAddress() As String

'default values
iAliasCount = 0
iAddressCount = 0
NameLookup = ""
' lookup by IP or name
If IsNumeric(Left$(LookupName, 1)) Then
  Debug.Print "Resolve IP: " & LookupName
  lHostent = gethostbyaddr(TextToIP(LookupName), 4, AF_INET)
  Debug.Print "Resolve Name: " & LookupName
  sTarget = LookupName & vbNullChar
  lHostent = gethostbyname(sTarget) ' do actual winsock call
End If
If lHostent = 0 Then
  NameLookup = 0
  Exit Function ' failed!
End If
lHEName = lHostent ' set pointer addresses
lHEAlias = lHostent + 4
lHEAddress = lHostent + 12
' convert addresses of pointers to the pointers...
CopyMemory lHEName, ByVal lHEName, 4
CopyMemory lHEAlias, ByVal lHEAlias, 4
CopyMemory lHEAddress, ByVal lHEAddress, 4

' Get resolved hostname
nbytes = lstrlen(ByVal lHEName)
If nbytes > 0 Then
  LookupName = Space$(nbytes)
  CopyMemory ByVal LookupName, ByVal lHEName, nbytes
Debug.Print "Full name: " & LookupName
End If

' get all IP addresses
CopyMemory lIPPointer, ByVal lHEAddress, 4
Do While lIPPointer ' end-of-list is null pointer
  ReDim Preserve sAddress(iAddressCount + 1)
  sAddress(iAddressCount) = Space$(4)
  CopyMemory ByVal sAddress(iAddressCount), ByVal lIPPointer, 4
Debug.Print "IP address " & CStr(iAddressCount) & _
  ": " & IPToText(sAddress(iAddressCount))
  CopyMemory ByVal lHEAddress, 0&, 4 ' null for next call
  iAddressCount = iAddressCount + 1
  ' move to next IP
  lHEAddress = lHEAddress + 4
  CopyMemory lIPPointer, ByVal lHEAddress, 4

' get any/all aliases
CopyMemory lAPointer, ByVal lHEAlias, 4
Do While lAPointer ' end-of-list is a null
  ReDim Preserve sAlias(iAliasCount + 1)
  nbytes = lstrlen(ByVal lAPointer)
  sAlias(iAliasCount) = Space$(nbytes)
  CopyMemory ByVal sAlias(iAliasCount), ByVal lAPointer, nbytes
Debug.Print "Alias " & CStr(iAliasCount) & ": " & _
  CopyMemory ByVal lHEAlias, 0&, 4
  iAliasCount = iAliasCount + 1
  ' move to next IP
  lHEAlias = lHEAlias + 4
  CopyMemory lAPointer, ByVal lHEAlias, 4

If iAddressCount > 0 Then
  ' success
  NameLookup = IPToText(sAddress(0))
  NameLookup = "" ' weird!
End If
End Function

Private Sub cmdResolve_Click()
Dim LookupName As String
Dim sIP As String
LookupName = txtIP.Text
sIP = NameLookup(LookupName)
txtIP.Text = sIP
End Sub

Private Sub cmdPing_Click()
Dim lAddress As Long ' IP address to ping
Dim lTimeOut As Long ' Timeout in milliseconds
Dim udtIRO As ICMPReqOpt ' ICMP Request Options
Dim udtIER As ICMPEchoReply ' ICMP Response
Dim bytResponse(1 To 4096) As Byte ' response buffer
Dim x As Long ' scratch
' convert IP Address
lAddress = TextToIP(Trim$(txtIP.Text))
' build request packet
udtIRO.TTL = Val("0" & txtTimeToLive.Text)
udtIRO.tos = ICMP_ECHO_REQUEST ' we want a simple PING
udtIRO.options = "" ' no options...
udtIRO.optsize = Len(udtIRO.options)
' do it
lTimeOut = Val("0" & txtTimeOut.Text)
x = IcmpSendEcho(hICMP, lAddress, Space$(32), 32, _
  udtIRO, bytResponse(1), UBound(bytResponse), _
If x = 0 Then
  ' call failed
  lblAddress.Caption = "ICMP ERROR"
  lblError.Caption = CStr(IcmpGetLastError())
  ' copy buffer to structure to make it easier
  CopyMemory udtIER.Address(1), bytResponse(1), LenB(udtIER)
  lblAddress.Caption = CStr(udtIER.Address(1)) & "." & _
    CStr(udtIER.Address(2)) & "." & _
    CStr(udtIER.Address(3)) & "." & _
  lblError.Caption = CStr(udtIER.status) & ":" & _
End If
End Sub

Private Sub Form_Load()
If WSAStartup(257, udtWSAData) 0 Then
  MsgBox "Unable to initialize Winsock", vbOKOnly, "Winsock Error"
  Unload Me
  Exit Sub
End If
hICMP = IcmpCreateFile()
If hICMP = 0 Then
  MsgBox "Unable to initialize ICMP", vbOKOnly, "ICMP Error"
  Unload Me
  Exit Sub
End If
txtIP.Text = MyHostName
End Sub

Private Sub Form_Unload(Cancel As Integer)
If hICMP Then Call IcmpCloseHandle(hICMP)
Call WSACleanup
Set Form1 = Nothing
End Sub

Author Comment

ID: 1439613
Adjusted points to 80

Expert Comment

ID: 1439614
*round of applause*

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There is an easy way, in .NET, to centralize the treatment of all unexpected errors. First of all, instead of launching the application directly in a Form, you need first to write a Sub called Main, in a module. Then, set the Startup Object to th…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
The viewer will learn how to implement Singleton Design Pattern in Java.
The goal of the video will be to teach the user the difference and consequence of passing data by value vs passing data by reference in C++. An example of passing data by value as well as an example of passing data by reference will be be given. Bot…
Suggested Courses
Course of the Month20 days, 2 hours left to enroll

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question