ftcpclient.frm

在Windows下用WinSock API开发的示例

VERSION 5.00
Begin VB.Form fTcpClient 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Winsock API Demo (TCP Client)"
   ClientHeight    =   5025
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5655
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5025
   ScaleWidth      =   5655
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtDisplay 
      Height          =   4215
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   120
      Width           =   5415
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "&Close"
      Height          =   375
      Left            =   4440
      TabIndex        =   0
      Top             =   4560
      Width           =   1095
   End
End
Attribute VB_Name = "fTcpClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
' ---------------------------------------------------------------------------------
' File...........: fTcpClient.frm
' Author.........: Will Barden
' Created........: 04/06/03
' Modified.......: 04/06/03
' Version........: 1.0
' Website........: http://www.WinsockVB.com
' Contact........: [e-mail]
'
' A simple form to demonstrate the techniques involved in setting up a TCP
' connection and transmitting data both ways. Start the server first, then start
' this. It runs quickly, but you can step through both apps with F8.
' ---------------------------------------------------------------------------------
'
' ---------------------------------------------------------------------------------
' Form events.
' ---------------------------------------------------------------------------------
'
Private Sub Form_Load()
   '
Dim udtData As WSADATA
Dim lngRet  As Long
   '
   Me.Show
   '
   ' Start Winsock up, and call the main sub.
   Call LogText("Starting Winsock 2")
   lngRet = WSAStartup(WINSOCK_V2_2, udtData)
   If (lngRet = ERROR_SUCCESS) Then
      '
      Call DoWinsockStuff
      '
      Call WSACleanup
      '
   Else
      Call LogText("WSAStartup() failed: " & vbGetLastError(lngRet))
   End If
   '
End Sub
'
' ---------------------------------------------------------------------------------
' Control events.
' ---------------------------------------------------------------------------------
'
Private Sub cmdClose_Click()
   '
   Call Unload(Me)
   '
End Sub
'
' ---------------------------------------------------------------------------------
' Private helpers
' ---------------------------------------------------------------------------------
'
Private Sub DoWinsockStuff()
   '
Dim hClientSocket As Long
Dim udtRemote     As sockaddr_in
Dim lngRet        As Long
Dim strData       As String
   '
   ' Create a client socket. This will be used to initiate the connection request.
   Call LogText("Creating a client socket")
   hClientSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
   If (hClientSocket <> INVALID_SOCKET) Then
      '
      ' Prepare the address which we want this socket to connect to.
      Call LogText("Connecting to 127.0.0.1")
      With udtRemote
         .sin_family = AF_INET
         .sin_addr.s_addr = vbInetAddr("127.0.0.1")
         .sin_port = htons(10101)
      End With
      lngRet = connect(hClientSocket, udtRemote, LenB(udtRemote))
      If (lngRet = ERROR_SUCCESS) Then
         '
         ' Now we're connected, send some data. It will be sent back to us reversed.
         strData = "Isn't the Winsock API great? :-)"
         Call SendData(hClientSocket, strData)
         Call LogText("Sent: " & strData)
         '
         strData = RecvData(hClientSocket)
         Call LogText("Received: " & strData)
         '
      Else
         Call LogText("connect() failed: " & vbGetLastError())
      End If
      '
      ' Everything is finished, so release the server socket.
      Call closesocket(hClientSocket)
      Call LogText("Connection closed")
      '
   Else
      Call LogText("Failed socket creation: " & vbGetLastError())
   End If
   '
End Sub
'
Private Sub SendData(ByVal hSocket As Long, _
                     ByVal strData As String)
   '
Dim bytData()     As Byte
Dim lngCount      As Long
Dim lngBytesSent  As Long
   '
   ' Convert the string data to a byte array, and count how many bytes there are.
   bytData = StrConv(strData, vbFromUnicode)
   lngCount = UBound(bytData) - LBound(bytData) + 1
   '
   ' Send the byte array, and check the return value for errors, just in case.
   lngBytesSent = send(hSocket, bytData(0), lngCount, 0&)
   If (lngBytesSent = SOCKET_ERROR) Then
      Call LogText("send() failed: " & vbGetLastError())
   End If
   '
End Sub
'
Private Function RecvData(ByVal hSocket As Long) As String
   '
Dim bytData()        As Byte
Dim lngCount         As Long
Dim lngBytesReceived As Long
Dim strData          As String
   '
   ' Prepare our receive buffer to 1KB (should be plenty of space).
   ReDim bytData(0 To 1023) As Byte
   lngCount = UBound(bytData) - LBound(bytData) + 1
   '
   ' Call receive, and check for errors.
   lngBytesReceived = recv(hSocket, bytData(0), lngCount, 0&)
   If (lngBytesReceived = SOCKET_ERROR) Then
      Call LogText("recv() failed: " & vbGetLastError())
   Else
      ' Convert the received data back into a string and return.
      strData = StrConv(bytData, vbUnicode)
      RecvData = Mid$(strData, 1, lngBytesReceived)
   End If
   '
End Function
'
Private Sub LogText(ByVal strText As String)
   '
   ' Add the text onto the end of the textbox.
   With txtDisplay
      .SelStart = Len(.Text)
      .SelText = strText & vbCrLf
      .SelStart = Len(.Text)
   End With
   '
End Sub
'
' ---------------------------------------------------------------------------------
' EOF.
' ---------------------------------------------------------------------------------
'