سلام
از کنترل Winsock برای برقراری ارتباط بین سرویس دهنده و سرویس گیرنده با دو پروتکل UDP و
TCP استفاده می شود.
پیاده سازی یک سرویس دهنده با پروتکل TCP :
ابتدا یک پروژه جدید باز کرده و کنترل Winsock و دو txtbox و یک Commandbutton روی فرم قرار دهید.نام یک تکست باکس را txtsend و نام دیگری راtxtoutput قرار داده و خاصیت Multiline آنرا به True ست کنید و نام کنترل Winsock را Tcpserver قرارداده و کد زیر را در پروژه خود کپی کنید :
Private Sub cmdsend_Click()
Call tcpserver.SendData("SERVER>>>" & txtsend.Text)
txtoutput.Text = txtoutput.Text & "SERVER>>>" & _
txtsend.Text & vbCrLf & vbCrLf
txtsend.Text = ""
txtoutput.SelStart = Len(txtoutput.Text)
End Sub
Private Sub Form_Load()
cmdsend.Enabled = False
tcpserver.LocalPort = 5000
Call tcpserver.Listen
End Sub
Private Sub Form_Terminate()
Call tcpserver.Close
End Sub
Private Sub tcpserver_Close()
cmdsend.Enabled = False
Call tcpserver.Close
txtoutput.Text = txtoutput.Text & _
"Client closed connection." & _
vbCrLf & vbCrLf
txtoutput.SelStart = Len(txtoutput.Text)
Call tcpserver.Listen
End Sub
Private Sub tcpserver_ConnectionRequest(ByVal requestID As Long)
If tcpserver.State <> sckClosed Then
Call tcpserver.Close
End If
cmdsend.Enabled = True
Call tcpserver.Accept(requestID)
txtoutput.Text = "Connection from IP address :" & _
tcpserver.RemoteHostIP & vbCrLf & "Port #:" & _
tcpserver.RemotePort & vbCrLf & vbCrLf
End Sub
Private Sub tcpserver_DataArrival(ByVal bytesTotal As Long)
Dim message As String
Call tcpserver.GetData(message)
txtoutput.Text = txtoutput.Text & message & vbCrLf & _
vbCrLf
txtoutput.SelStart = Len(txtoutput.Text)
End Sub
Private Sub tcpserver_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Dim result As Integer
result = MsgBox(Source & ":" & Description, vbOKOnly, _
"TCp/IP Error")
End Sub
پیاده سازی یک سرویس گیرنده با پروتکل TCP :
ابتدا یک پروژه جدید باز کرده و کنترل Winsock و دو txtbox و یک Commandbutton روی فرم قرار دهید.نام یک تکست باکس را txtsend و نام دیگری راtxtoutput قرار داده و خاصیت Multiline آنرا به True ست کنید و نام کنترل Winsock را Tcpclient قرارداده و کد زیر را در پروژه خود کپی کنید :
Private Sub cmdsend_Click()
Call tcpclient.SendData("CLIENT >>>" & txtsend.Text)
txtoutput.Text = txtoutput.Text & "CLIENT >>>" & _
txtsend.Text & vbCrLf & vbCrLf
txtoutput.SelStart = Len(txtoutput.Text)
txtsend.Text = ""
End Sub
Private Sub Form_Load()
cmdsend.Enabled = False
tcpclient.RemoteHost = _
InputBox("Enter the remot host IP address", _
"IP Address", "Localhost")
If tcpclient.RemoteHost = "" Then
tcpclient.RemoteHost = "Localhost"
End If
tcpclient.RemotePort = 5000
Call tcpclient.Connect
End Sub
Private Sub Form_Terminate()
Call tcpclient.Close
End Sub
Private Sub tcpclient_Close()
cmdsend.Enabled = False
Call tcpclient.Close
txtoutput.Text = txtoutput.Text & _
"Server closed connection" & vbCrLf
txtoutput.SelStart = Len(txtoutput)
End Sub
Private Sub tcpclient_Connect()
cmdsend.Enabled = True
txtoutput.Text = "Connected to IP address" & _
tcpclient.RemoteHostIP & vbCrLf & "Port #:" & _
tcpclient.RemotePort & vbCrLf & vbCrLf
End Sub
Private Sub tcpclient_DataArrival(ByVal bytesTotal As Long)
Dim message As String
Call tcpclient.GetData(message)
txtoutput.Text = txtoutput.Text & message & _
vbCrLf & vbCrLf
txtoutput.SelStart = Len(txtoutput)
End Sub
Private Sub tcpclient_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Dim result As Integer
result = MsgBox(Source & ":" & Description _
, vbOKOnly, "TCP/IP Error")
End Sub
پیاده سازی یک سرویس دهنده با پروتکل UDP:
ابتدا یک پروژه جدید باز کرده و کنترل Winsock و دو txtbox و یک Commandbutton روی فرم قرار دهید.نام یک تکست باکس را txtsend و نام دیگری راtxtoutput قرار داده و خاصیت Multiline آنرا به True ست کنید و نام کنترل Winsock را udpsever و خاصیت Protocol آنرابه sck UDPProtocol ست کرده و کد زیر را در پروژه خود کپی کنید :
Private Sub cmdsend_Click()
Call udpserver.SendData(txtsend.Text)
txtoutput.Text = txtoutput.Text & "Send Message :" & _
txtsend.Text & vbCrLf & vbCrLf
txtsend.Text = ""
txtoutput.SelStart = Len(txtoutput.Text)
udpserver.RemotePort = 0
End Sub
Private Sub Form_Load()
Call udpserver.Bind(5000)
End Sub
Private Sub Form_Terminate()
Call udpserver.Close
End Sub
Private Sub udpserver_DataArrival(ByVal bytesTotal As Long)
Dim message As String
Call udpserver.GetData(message)
txtoutput.Text = txtoutput.Text & "Form1 Ip Address :" & _
udpserver.RemoteHostIP & vbCrLf & "Port #: " & _
Str$(udpserver.RemotePort) & vbCrLf & "Bytes received :" & _
Str$(bytesTotal) & vbCrLf & "Message :" & message & vbCrLf & _
vbCrLf
End Sub
پیاده سازی یک سرویس'گیرنده با پروتکل UDP:
ابتدا یک پروژه جدید باز کرده و کنترل Winsock و دو txtbox و یک Commandbutton روی فرم قرار دهید.نام یک تکست باکس را txtsend و نام دیگری راtxtoutput قرار داده و خاصیت Multiline آنرا به True ست کنید و نام کنترل Winsock را udpclient و خاصیت Protocol آنرابه sck UDPProtocol ست کرده و کد زیر را در پروژه خود کپی کنید :
Private Sub cmdsend_Click()
Call udpclient.SendData(txtsend.Text)
txtoutput.Text = txtoutput.Text & "Send Message :" & _
txtsend.Text & vbCrLf & vbCrLf
txtsend.Text = ""
txtoutput.SelStart = Len(txtoutput.Text)
End Sub
Private Sub Form_Load()
udpclient.RemoteHost = InputBox("Enter the remote host IP address" _
, "IP address", "localhost")
If udpclient.RemoteHost = "" Then
udpclient.RemoteHost = "localhost"
End If
udpclient.RemotePort = 5000
End Sub
Private Sub Form_Terminate()
Call udpclient.Close
End Sub
Private Sub udpclient_DataArrival(ByVal bytesTotal As Long)
Dim message As String
Call udpclient.GetData(message)
txtoutput.Text = txtoutput.Text & "Form1 Ip Address :" & _
udpclientRemoteHostIP & vbCrLf & "Port #: " & _
Str$(udpclient.RemotePort) & vbCrLf & "Bytes received :" & _
Str$(bytesTotal) & vbCrLf & "Message :" & message & vbCrLf
End Sub
با کمی سعی می توانید یک برنامه چت درست کنید! :wink:
موفق و پیروز باشید 8)