码迷,mamicode.com
首页 > Web开发 > 详细

delphpi tcp 服务和客户端 例子

时间:2020-01-07 16:06:24      阅读:105      评论:0      收藏:0      [点我收藏+]

标签:ESS   use   stdcall   onclick   proc   bin   integer   final   procedure   

//服务器端
unit
Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,Winapi.WinSock; type clients = record soc :TSocket; add :sockaddr_in; end; pclients = ^clients; TForm1 = class(TForm) btn1: TButton; mmo1: TMemo; procedure btn1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public s :TSocket; acThreadID :DWORD; end; procedure ServerAccept(s :TSocket);stdcall; procedure SocketWorkThread(ns :TSocket);stdcall; const buflen=100; var Form1: TForm1; clientslist :TList; implementation {$R *.dfm} procedure SocketWorkThread(ns :TSocket);stdcall; var recvbuf :array[0..buflen -1] of Char; rtn,k :Integer; rs :string[buflen]; rs2:string; error :string; begin try while true do begin rtn := recv(ns,recvbuf,buflen,0); if rtn < 1 then begin for k := 0 to clientslist.Count -1 do begin if ns = pclients(clientslist.Items[k]).soc then begin freemem(clientslist.Items[k]); //zl 我自己增加的,感觉要释放下 clientslist.Delete(k); Break; end else Continue; end; CLOSESOCKET(ns); error := IntToHex(ns,2)+退出; Form1.mmo1.Lines.Add(error); ExitThread(0); end; //rs := PChar(@recvbuf); rs2 := StrPas(recvbuf); //ShowMessage(‘rs==‘+rs); Form1.mmo1.Lines.Add(rs2); end; except end; end; procedure ServerAccept(s :TSocket);stdcall; var ra :sockaddr_in; ra_len :integer; recev :TSocket; ThreadID :DWORD; ip :string; newclient :pclients; begin ra_len := SizeOf(ra); try while True do begin recev := accept(s,@ra,@ra_len); if recev = -1 then begin ExitThread(0); end; ip := IntToHex(recev,2)+-+ IntToStr(Ord(ra.sin_addr.S_un_b.s_b1))+.+ IntToStr(Ord(ra.sin_addr.S_un_b.s_b2))+.+ IntToStr(Ord(ra.sin_addr.S_un_b.s_b3))+.+ IntToStr(Ord(ra.sin_addr.S_un_b.s_b4)); Form1.mmo1.Lines.Add(ip); GetMem(newclient,SizeOf(clients)); newclient.soc := recev; newclient.add := ra; clientslist.Add(newclient); CreateThread(nil,0,@SocketWorkThread,Pointer(recev),0,ThreadID); end; except end; end; procedure TForm1.btn1Click(Sender: TObject); var wsa:TWSAData; wsstatus:Integer; sa:sockaddr_in; begin wsstatus := WSAStartup($0202,wsa); if wsstatus<> 0 then begin ShowMessage(初始化socket出错!); Exit; end; s := Socket(AF_INET,SOCK_STREAM,0); if s < 0 then begin ShowMessage(创建socket出错!); WSACleanup; Exit; end; sa.sin_port := htons(StrToInt(2002)); sa.sin_family := AF_INET; sa.sin_addr.S_addr := INADDR_ANY; wsstatus := bind(s,sa,SizeOf(sa)); if wsstatus <> 0 then begin ShowMessage(绑定socket出错); WSACleanup; Exit; end; wsstatus := listen(s,5); if wsstatus <> 0 then begin ShowMessage(监听出错!); WSACleanup; Exit; end; clientslist := TList.Create; CreateThread(nil,0,@ServerAccept,Pointer(s),0,acThreadID); btn1.Enabled := False; form1.Caption:= 服务端已启动; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin clientslist.Free; //zl 我自己增加的,感觉要释放 end; end. //客户端 unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,Winapi.WinSock, Vcl.StdCtrls; type TForm1 = class(TForm) btnCon: TButton; btnSend: TButton; btnDis: TButton; mmo1: TMemo; edtSend: TEdit; procedure btnConClick(Sender: TObject); procedure btnDisClick(Sender: TObject); procedure btnSendClick(Sender: TObject); private { Private declarations } public s:TSocket; end; procedure Receive(server :TSocket);stdcall; const buflen = 100; var Form1: TForm1; implementation {$R *.dfm} procedure Receive(server :TSocket);stdcall; var recbuf:array[0..buflen -1] of Char; rtn :Integer; rs :string; begin while True do begin rtn := recv(server,recbuf,buflen,0); if rtn < 1 then begin closesocket(server); ExitThread(0); end; rs := pchar(@recbuf); Form1.mmo1.Lines.Add(rs); end; end; procedure TForm1.btnConClick(Sender: TObject); var sa :TWSAData; wstates :Integer; ad :sockaddr_in; threadid :DWORD; begin wstates := WSAStartup($0202,sa); if wstates <> 0 then begin ShowMessage(socket初始化出错!); Exit; end; s := socket(PF_INET,SOCK_STREAM,IPPROTO_IP); if s = INVALID_SOCKET then begin ShowMessage(建立socket出错!); WSACleanup; Exit; end; ad.sin_family := PF_INET; ad.sin_port := htons(StrToInt(2002)); ad.sin_addr.S_addr := inet_addr(PAnsiChar(127.0.0.1)); wstates := connect(s,ad,SizeOf(ad)); if wstates <> 0 then begin ShowMessage(连接错误); WSACleanup; btnCon.Enabled := false; Exit; end; CreateThread(nil,0,@Receive,Pointer(s),0,threadid); end; procedure TForm1.btnDisClick(Sender: TObject); begin try closesocket(s); WSACleanup; finally btnCon.Enabled := True; end; end; procedure TForm1.btnSendClick(Sender: TObject); var sendbuf :array[0..buflen -1] of Char; sendLen :Integer; i :Integer; begin if edtSend.Text <> ‘‘ then begin FillChar(sendbuf,100,0); //此处重要: 否则接收端 容易出现个别乱码现象 for i := 0 to Length(edtSend.Text) -1 do sendbuf[i] := (edtSend.Text)[i+1]; sendLen := send(s,sendbuf,buflen,0); if sendLen < 0 then begin ShowMessage(发送出错); WSACleanup; btnCon.Enabled := False; Exit; end; end; end; end.

delphpi tcp 服务和客户端 例子

标签:ESS   use   stdcall   onclick   proc   bin   integer   final   procedure   

原文地址:https://www.cnblogs.com/tobetterlife/p/12161930.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!