How to use: WSock32.dll/MsWSock.dll/WinSock.dll/WS2_32.dll

Hi,
How can i use WSock32.dll/MsWSock.dll/WinSock.dll/WS2_32.dll in VB(6.0)?
For: Send/Receive/Get/Post/Listetn...
Very thanks. ;)

????

This example uses WSOCK32.DLL. I do not know if the other socket DLLs will also work with this code. You can substitute them if you wish and give it a try.

Most of the code shown is from Microsoft http://support.microsoft.com/kb/154512

Start a VB project. Add to the Form two Textboxes, two Command Buttons, and a Label.

Command Buttons: cmdPing; cmdTraceRT
Textboxes: txtHost; txtResponse
Label: lblIP

Copy and Paste below code to a .BAS Module

Code:

---

Type Inet_address
  Byte4 As String * 1
  Byte3 As String * 1
  Byte2 As String * 1
  Byte1 As String * 1
End Type

Type WSAdata
  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

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

Type IP_OPTION_INFORMATION
  TTL As Byte
  Tos As Byte
  Flags As Byte
  OptionsSize As Long
  OptionsData As String * 128
End Type

Type IP_ECHO_REPLY
  Address(0 To 3) As Byte
  Status As Long
  RoundTripTime As Long
  DataSize As Integer
  Reserved As Integer
  data As Long
  Options As IP_OPTION_INFORMATION
End Type

Public pIPe As IP_ECHO_REPLY
Public pIPo As IP_OPTION_INFORMATION
Public IPLong As Inet_address

Public Declare Function gethostname Lib "wsock32.dll" (ByVal hostname$, HostLen&) As Long

Public Declare Function gethostbyname& Lib "wsock32.dll" (ByVal hostname$)

Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long

Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAData As WSAdata) As Long

Public Declare Function WSACleanup Lib "wsock32.dll" () As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
 (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Declare Function IcmpCreateFile Lib "ICMP.dll" () As Long

Public Declare Function IcmpCloseHandle Lib "ICMP.dll" (ByVal HANDLE As Long) As Boolean

Public Declare Function IcmpSendEcho Lib "ICMP" _
 (ByVal IcmpHandle As Long, _
  ByVal DestAddress As Long, _
  ByVal RequestData As String, _
  ByVal RequestSize As Integer, _
  RequestOptns As IP_OPTION_INFORMATION, _
  ReplyBuffer As IP_ECHO_REPLY, _
  ByVal ReplySize As Long, _
  ByVal TimeOut As Long) As Boolean

'
' WSock32 Constants
'
Const WS_VERSION_MAJOR = &H100 And &HFF&
Const WS_VERSION_MINOR = &H101 And &HFF&
Const MIN_SOCKETS_REQD = 0

---

]

Continued from Above Post

Copy and Paste below code to a Form Module

Code:

---

'
' WSock32 Variables
'
Dim iReturn As Long
Dim sLowByte As String
Dim sHighByte As String
Dim sMsg As String
Dim HostLen As Long
Dim Host As String
Dim Hostent As Hostent
Dim PointerToPointer As Long
Dim ListAddress As Long
Dim WSAdata As WSAdata
Dim DotA As Long
Dim DotAddr As String
Dim ListAddr As Long
Dim MaxUDP As Long
Dim MaxSockets As Long
Dim i As Integer
Dim Description As String
Dim Status As String

'
' Ping Variables
'
Dim bReturn As Boolean
Dim hIP As Long
Dim szBuffer As String
Dim Addr As Long
Dim RCode As String
Dim RespondingHost As String

'
' TRACERT Variables
'
Dim TraceRT As Boolean
Dim TTL As Integer

Private Sub Form_Load()
 txtHost = ""
 txtResponse = ""
End Sub

Private Sub GetRCode()
 If pIPe.Status = 0 Then RCode = "Success"
 If pIPe.Status = 11001 Then RCode = "Buffer too Small"
 If pIPe.Status = 11003 Then RCode = "Dest Host Not Reachable"
 If pIPe.Status = 11004 Then RCode = "Dest Protocol Not Reachable"
 If pIPe.Status = 11005 Then RCode = "Dest Port Not Reachable"
 If pIPe.Status = 11006 Then RCode = "No Resources Available"
 If pIPe.Status = 11007 Then RCode = "Bad Option"
 If pIPe.Status = 11008 Then RCode = "Hardware Error"
 If pIPe.Status = 11009 Then RCode = "Packet too Big"
 If pIPe.Status = 11010 Then RCode = "Rqst Timed Out"
 If pIPe.Status = 11011 Then RCode = "Bad Request"
 If pIPe.Status = 11012 Then RCode = "Bad Route"
 If pIPe.Status = 11013 Then RCode = "TTL Exprd in Transit"
 If pIPe.Status = 11014 Then RCode = "TTL Exprd Reassemb"
 If pIPe.Status = 11015 Then RCode = "Parameter Problem"
 If pIPe.Status = 11016 Then RCode = "Source Quench"
 If pIPe.Status = 11017 Then RCode = "Option too Big"
 If pIPe.Status = 11018 Then RCode = " Bad Destination"
 If pIPe.Status = 11019 Then RCode = "Address Deleted"
 If pIPe.Status = 11020 Then RCode = "Spec MTU Change"
 If pIPe.Status = 11021 Then RCode = "MTU Change"
 If pIPe.Status = 11022 Then RCode = "Unload"
 If pIPe.Status = 11050 Then RCode = "General Failure"
 
 RCode = RCode + " (" + CStr(pIPe.Status) + ")"

 DoEvents
  If TraceRT = False Then
    If pIPe.Status = 0 Then
      txtResponse.Text = txtResponse.Text + " Reply from " + RespondingHost + ": Bytes = " + Trim$(CStr(pIPe.DataSize)) + " RTT = " + Trim$(CStr(pIPe.RoundTripTime)) + "ms TTL = " + Trim$(CStr(pIPe.Options.TTL)) + Chr$(13) + Chr$(10)
    Else
      txtResponse.Text = txtResponse.Text + " Reply from " + RespondingHost + ": " + RCode + Chr$(13) + Chr$(10)
    End If
  Else
    If TTL - 1 < 10 Then
      txtResponse.Text = txtResponse.Text + " # 0" + CStr(TTL - 1)
    Else
      txtResponse.Text = txtResponse.Text + " # " + CStr(TTL - 1)
      txtResponse.Text = txtResponse.Text + " " + RespondingHost + Chr$(13) + Chr$(10)
    End If
  End If
End Sub

Private Sub vbGetHostByName()
 Dim szString As String
 
 Host = Trim$(txtHost.Text)
 
 szString = String(64, &H0)
 
 Host = Host + Right$(szString, 64 - Len(Host))

 If gethostbyname(Host) = SOCKET_ERROR Then
  sMsg = "Winsock Error" & Str$(WSAGetLastError())
  MsgBox sMsg, 0, ""
 Else
  PointerToPointer = gethostbyname(Host) ' Get the pointer to the address of the winsock hostent structure
  CopyMemory Hostent.h_name, ByVal PointerToPointer, Len(Hostent)  ' Copy Winsock structure to the VisualBasic structure
 
  ListAddress = Hostent.h_addr_list ' Get the ListAddress of the Address List
 
  CopyMemory ListAddr, ByVal ListAddress, 4 ' Copy Winsock structure to the VisualBasic structure
  CopyMemory IPLong, ByVal ListAddr, 4 ' Get the first list entry from the Address List
  CopyMemory Addr, ByVal ListAddr, 4
     
  lblIP.Caption = Trim$(CStr(Asc(IPLong.Byte4)) & "." & CStr(Asc(IPLong.Byte3)) _
    & "." & CStr(Asc(IPLong.Byte2)) & "." + CStr(Asc(IPLong.Byte1)))
 End If
End Sub

Private Sub vbGetHostName()
 Host = String(64, &H0)

 If gethostname(Host, HostLen) = SOCKET_ERROR Then
  sMsg = "WSock32 Error" & Str$(WSAGetLastError())
  MsgBox sMsg, 0, ""
 Else
  Host = Left$(Trim$(Host), Len(Trim$(Host)) - 1)
  txtHost.Text = Host
 End If
End Sub

Private Sub vbIcmpSendEcho()
 Dim NbrOfPkts As Integer
 
 szBuffer = "abcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklmnopqrstuvwabcdefghijklm"
 szBuffer = Left$(szBuffer, Val(32))

 If IsNumeric(1) Then
 End If

 If TraceRT = True Then
 End If

 For NbrOfPkts = 1 To Trim$(1)
  DoEvents
   
  bReturn = IcmpSendEcho(hIP, Addr, szBuffer, Len(szBuffer), pIPo, pIPe, Len(pIPe) + 8, 2700)

  If bReturn Then
    RespondingHost = CStr(pIPe.Address(0)) + "." + CStr(pIPe.Address(1)) + "." + CStr(pIPe.Address(2)) + "." + CStr(pIPe.Address(3))
    GetRCode
  Else
    If TraceRT Then
      TTL = TTL - 1
    Else
      txtResponse.Text = txtResponse.Text + "Request Timeout" + Chr$(13) + Chr$(10)
    End If
  End If
 Next NbrOfPkts
End Sub

Sub vbWSAStartup()
 iReturn = WSAStartup(&H101, WSAdata)

 If iReturn <> 0 Then ' If WSock32 error, then tell me about it
  MsgBox "WSock32.dll is not responding!", 0, ""
 End If

 If LoByte(WSAdata.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAdata.wVersion) = WS_VERSION_MAJOR And HiByte(WSAdata.wVersion) < WS_VERSION_MINOR) Then
  sHighByte = Trim$(Str$(HiByte(WSAdata.wVersion)))
  sLowByte = Trim$(Str$(LoByte(WSAdata.wVersion)))
     
  sMsg = "WinSock Version " & sLowByte & "." & sHighByte
  sMsg = sMsg & " is not supported "
     
  MsgBox sMsg
 
  End
 End If

 If WSAdata.iMaxSockets < MIN_SOCKETS_REQD Then
  sMsg = "This application requires a minimum of "
  sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
       
  MsgBox sMsg
 
  End
 End If

 MaxSockets = WSAdata.iMaxSockets

 If MaxSockets < 0 Then
  MaxSockets = 65536 + MaxSockets
 End If

 MaxUDP = WSAdata.iMaxUdpDg

 If MaxUDP < 0 Then
  MaxUDP = 65536 + MaxUDP
 End If

 Description = ""

 For i = 0 To WSADESCRIPTION_LEN
  If WSAdata.szDescription(i) = 0 Then Exit For
     
  Description = Description + Chr$(WSAdata.szDescription(i))
 Next i

 Status = ""

 For i = 0 To WSASYS_STATUS_LEN
  If WSAdata.szSystemStatus(i) = 0 Then Exit For
     
  Status = Status + Chr$(WSAdata.szSystemStatus(i))
 Next i
End Sub

Private Function HiByte(ByVal wParam As Integer)
 HiByte = wParam \ &H100 And &HFF&
End Function

Private Function LoByte(ByVal wParam As Integer)
 LoByte = wParam And &HFF&
End Function

Private Sub vbWSACleanup()
 iReturn = WSACleanup()
End Sub

Private Sub vbIcmpCloseHandle()
 bReturn = IcmpCloseHandle(hIP)
End Sub

Private Sub vbIcmpCreateFile()
 hIP = IcmpCreateFile()
End Sub

Private Sub cmdPing_Click()
 txtResponse.Enabled = True
 txtResponse.Text = ""
 
 vbWSAStartup ''' Initialize Winsock

 If Len(txtHost.Text) = 0 Then
  vbGetHostName
 End If

 vbGetHostByName ' Get the IPAddress For the Host
 vbIcmpCreateFile ' Get ICMP Handle
 
 '
 ' The following determines the TTL of the ICMPEcho
 '
 pIPo.TTL = Trim$(255)
 vbIcmpSendEcho ''' Send the ICMP Echo Request
 vbIcmpCloseHandle ' Close the ICMP Handle
 vbWSACleanup ''' Close Winsock
End Sub

Private Sub ClearResponse_Click()
 txtResponse.Text = "" 'Clear IP
End Sub

Private Sub cmdTraceRT_Click()
 txtResponse.Enabled = True
 txtResponse.Text = ""
 
 vbWSAStartup

 If Len(txtHost.Text) = 0 Then
  vbGetHostName
 End If

 vbGetHostByName
 vbIcmpCreateFile
 
 '
 ' The following determines the TTL of the ICMPEcho for TRACE function
 '
 TraceRT = True
 
 txtResponse.Text = txtResponse.Text + "Tracing Route to " + lblIP.Caption + ":" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)

 For TTL = 2 To 255
  pIPo.TTL = TTL
 
  vbIcmpSendEcho

  DoEvents

  If RespondingHost = lblIP.Caption Then
    txtResponse.Text = txtResponse.Text + Chr$(13) + Chr$(10) + "Route Trace has Completed" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
     
    Exit For ' Stop TraceRT
  End If
 Next TTL

 TraceRT = False
 
 vbIcmpCloseHandle
 vbWSACleanup
End Sub

---

Quote:

---

Originally Posted by Y.P.Y

????

---

Were you aware that this thread is started on Jan 20th, 2008?