-
Jan 20th, 2008, 05:50 AM
#1
Thread Starter
Addicted Member
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.
-
Dec 16th, 2008, 08:26 AM
#2
Lively Member
Re: How to use: WSock32.dll/MsWSock.dll/WinSock.dll/WS2_32.dll
-
Dec 16th, 2008, 08:24 PM
#3
Re: How to use: WSock32.dll/MsWSock.dll/WinSock.dll/WS2_32.dll
Originally Posted by Y.P.Y
????
Were you aware that this thread is started on Jan 20th, 2008?
-
Dec 16th, 2008, 11:33 AM
#4
Re: How to use: WSock32.dll/MsWSock.dll/WinSock.dll/WS2_32.dll
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
]
-
Dec 16th, 2008, 11:34 AM
#5
Re: How to use: WSock32.dll/MsWSock.dll/WinSock.dll/WS2_32.dll
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|