Solved

VB5 Simple Winsock Control question

Posted on 1998-10-13
13
234 Views
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?
0
Comment
Question by:ChrisK
  • 6
  • 3
  • 2
  • +1
13 Comments
 
LVL 1

Expert Comment

by:cvidler
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.
0
 
LVL 2

Author Comment

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

Expert Comment

by:cvidler
ID: 1439604
I'll have to check on it.... sorry
0
 
LVL 2

Author Comment

by:ChrisK
ID: 1439605
...
0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1439606
Change your network settings in the control panel. Bind your network to your dialup adapter iso your other one.
0
 
LVL 2

Author Comment

by:ChrisK
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.

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Expert Comment

by:LadyVyxen
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.
0
 
LVL 2

Author Comment

by:ChrisK
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 192.168.0.1, 192.168.0.2 ...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....
0
 
LVL 13

Accepted Solution

by:
Mirkwood earned 80 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

http://jimhuff.user.shentel.net/vbWinSck/vb_WinSck.HTM

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

Author Comment

by:ChrisK
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?

Thanks...
0
 
LVL 13

Expert Comment

by:Mirkwood
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_DEST_PROT_UNREACHABLE = 11004
Private Const ICMP_DEST_PORT_UNREACHABLE = 11005
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_TRANSMIT = 11013
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
Private Const ICMP_FLAG_NO_FRAGMENT = 2
' 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_LOOSE_SOURCE_ROUTE = &H82
Private Const ICMP_STRICT_SOURCE_ROUTE = &H83
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
  Else
    ' 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)
Else
  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
Loop

' 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) & ": " & _
  sAlias(iAliasCount)
  CopyMemory ByVal lHEAlias, 0&, 4
  iAliasCount = iAliasCount + 1
  ' move to next IP
  lHEAlias = lHEAlias + 4
  CopyMemory lAPointer, ByVal lHEAlias, 4
Loop

If iAddressCount > 0 Then
  ' success
  NameLookup = IPToText(sAddress(0))
Else
  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)
udtIRO.flags = ICMP_FLAG_NO_FRAGMENT
' do it
lTimeOut = Val("0" & txtTimeOut.Text)
x = IcmpSendEcho(hICMP, lAddress, Space$(32), 32, _
  udtIRO, bytResponse(1), UBound(bytResponse), _
  lTimeOut)
If x = 0 Then
  ' call failed
  lblAddress.Caption = "ICMP ERROR"
  lblError.Caption = CStr(IcmpGetLastError())
Else
  ' 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)) & "." & _
    CStr(udtIER.Address(4))
  lblError.Caption = CStr(udtIER.status) & ":" & _
    CStr(udtIER.triptime)
End If
End Sub

Private Sub Form_Load()
Dim udtWSAData As WSADATA
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
0
 
LVL 2

Author Comment

by:ChrisK
ID: 1439613
Adjusted points to 80
0
 

Expert Comment

by:LadyVyxen
ID: 1439614
*round of applause*
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
This video teaches viewers about errors in exception handling.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …

746 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now