您的位置：首页 > 理论基础 > 计算机网络

delphi利用Window API编写基于socket的tcp程序

2007-11-09 12:58 666 查看

客户机和服务器可用互相通讯。直接贴出代码吧，没有优化，代码可能有些冗余，只是实现了互相发送字符串的功能。仅供参考。

服务器端：

unit untserver;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Winsock;

type
clients = record
soc :TSocket;
add :sockaddr_in;
end;
pclients = ^clients;

Tserver = class(TForm)
edt1: TEdit;
lbl1: TLabel;
btn1: TButton;
mmo1: TMemo;
lbl2: TLabel;
edt2: TEdit;
btn2: TButton;
btn3: TButton;
edt3: TEdit;
procedure btn1Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
{ Private declarations }
public
s :TSocket;
acThreadID :DWORD;
end;

procedure ServerAccept(s :TSocket);stdcall;
procedure SocketWorkThread(ns :TSocket);stdcall;
const buflen=100;

var
server: Tserver;
clientslist :TList;

implementation

{$R *.dfm}

procedure Tserver.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(edt1.Text));
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;
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));
server.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 SocketWorkThread(ns :TSocket);stdcall;
var
recvbuf :array[0..buflen -1] of Char;
rtn,k :Integer;
rs :string[buflen];
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
clientslist.Delete(k);
Break;
end
else
Continue;
end;
CLOSESOCKET(ns);
error := IntToHex(ns,2)+'退出';
server.mmo1.Lines.Add(error);
ExitThread(0);
end;
rs := PChar(@recvbuf);
server.mmo1.Lines.Add(rs);
end;
except
end;
end;

end.

客户端：

unit untclient;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,WinSock;

type
Tclient = class(TForm)
edt1: TEdit;
edt2: TEdit;
lbl1: TLabel;
lbl2: TLabel;
edt3: TEdit;
btn1: TButton;
btn2: TButton;
btn3: TButton;
mmo1: TMemo;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
private
{ Private declarations }
public
s :TSocket;
end;

procedure Receive(server :TSocket);stdcall;
const buflen = 100;

var
client: Tclient;

implementation

{$R *.dfm}

procedure Tclient.btn1Click(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(edt2.Text));
ad.sin_addr.S_addr := inet_addr(PChar(edt1.Text));
wstates := connect(s,ad,SizeOf(ad));
if wstates <> 0 then
begin
ShowMessage('连接错误');
WSACleanup;
Exit;
end;
btn1.Enabled := False;
CreateThread(nil,0,@Receive,Pointer(s),0,threadid);
end;

procedure Tclient.btn2Click(Sender: TObject);
var
sendbuf :array[0..buflen -1] of Char;
sendLen :Integer;
i :Integer;
begin
if edt3.Text <> '' then
begin
for i := 0 to Length(edt3.Text) -1 do
sendbuf[i] := (edt3.Text)[i+1];
sendLen := send(s,sendbuf,buflen,0);
if sendLen < 0 then
begin
ShowMessage('发送出错');
WSACleanup;
btn1.Enabled := False;
Exit;
end;
end;
end;

procedure Tclient.btn3Click(Sender: TObject);
begin
try
closesocket(s);
WSACleanup;
finally
btn1.Enabled := True;
end;
end;

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);
client.mmo1.Lines.Add(rs);
end;
end;
end.

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签：

相关文章推荐

新的分享

章节导航