//客户端
unit Unit_client;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ComCtrls, ExtCtrls;
type
TfrmMain = class(TForm)
Statusbar1: TStatusBar;
Memo1: TMemo;
Client: TClientSocket;
Edit1: TEdit;
Button1: TButton;
Bevel1: TBevel;
Label1: TLabel;
edtHost: TEdit;
Label2: TLabel;
edtPort: TEdit;
btnConnect: TButton;
bntDisConnect: TButton;
btnSend: TButton;
procedure ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Memo1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure bntDisConnectClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
TotalLen:Integer;
implementation
uses ShellAPI;
{$R *.DFM}
procedure TfrmMain.ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels.Items[0].Text:='接受连接';
Statusbar1.Panels.items[1].text:='';
end;
procedure TfrmMain.btnSendClick(Sender: TObject);
begin
if client.Active then
begin
Client.Socket.SendText(Edit1.Text);
edit1.SelectAll;
end;
end;
procedure TfrmMain.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
re
char;
sbuf:string;
relong:integer;
begin
re:=nil;
while socket.ReceiveLength>0 do
begin
//申请内存
re:=AllocMem(socket.receivelength);
TRY
relong:=socket.ReceiveLength;
Socket.ReceiveBuf(re^,Socket.receivelength);
sBuf:=strpas(re);
Setlength(sbuf,relong);
//计算数据长度
TotalLen:=TotalLen+ relong;
Statusbar1.Panels.Items[1].Text:='总共接收(Byte): ' + IntToStr(TotalLen);
Statusbar1.Update();
FINALLY
freemem(re);
END;
Memo1.Lines.Add(sbuf);
end;
end;
procedure TfrmMain.ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels.Items[0].Text:='关闭与主机的连接';
Statusbar1.Panels.Items[0].Text:='';
Memo1.Lines.Clear;
edit1.Text:='';
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Client.Active then
Client.Close;
end;
procedure TfrmMain.Memo1Click(Sender: TObject);
begin
Edit1.SetFocus;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
ShellExecute(self.handle,nil,Pchar(Application.EXEname),nil,nil,SW_Normal);
end;
procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
Client.Address:=edtHost.Text;
Client.Port:=strtoint(edtPort.Text);
Client.Active:=true;
end;
procedure TfrmMain.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
if not Client.Active then
btnConnectClick(Sender);
Client.Socket.SendText(Edit1.Text);
edit1.SelectAll;
key:=#0;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
edtHost.Text:='166.111.187.2';
edtPort.Text:='4012';
TotalLen:=0;
end;
procedure TfrmMain.bntDisConnectClick(Sender: TObject);
begin
Client.Active:=False;
end;
end.
服务器端
unit Unit_Server;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ScktComp,Winsock, ExtCtrls;
type
TForm1 = class(TForm)
Server: TServerSocket;
btnSend: TButton;
edtSend: TEdit;
Label1: TLabel;
btnOneSend: TButton;
Label3: TLabel;
Label4: TLabel;
Bevel1: TBevel;
Combox1: TComboBox;
Statusbar1: TStatusBar;
Memo1: TMemo;
procedure ServerClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure btnSendClick(Sender: TObject);
procedure ServerClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure btnOneSendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Type UsrRec=Record
SocketID:Integer;
UsrName:string;
Passwd:string;
IP:string;
ReceivingData:string;
End;
var
Form1: TForm1;
buf:string;
bEUserName,bEPasswd:Boolean;
Usr:^UsrRec;
implementation
{$R *.DFM}
procedure TForm1.ServerClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
Var
strIp,strHost:string;
Count:Integer;
begin
strIp:=Socket.RemoteAddress;
strHost:=Socket.RemoteHost;
Memo1.Lines.Add('当前登录用户');
Memo1.Lines.add(#9'SocketID:'+Inttostr(Socket.SocketHandle));
Combox1.Items.Add(Inttostr(Socket.SocketHandle));
Memo1.lines.add(#9'IP地址:'+strIp);
Memo1.Lines.Add(#9'主机名:'+strHost);
Count:=Server.Socket.ActiveConnections;
Statusbar1.Panels.Items[1].Text:='在线用户: '+IntToStr(Count);
end;
procedure TForm1.ServerClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
p
char;
length:longint;
Count,i:Integer;
begin
p:=nil;
while socket.ReceiveLength>0 do begin
length:=socket.receivelength;
Getmem(p,length);
TRY
socket.ReceiveBuf(p^,socket.receivelength);
Count:=Server.Socket.ActiveConnections;
for i:=0 to Count-1 do
Server.Socket.Connections
.SendBuf(p^,length);
FINALLY
FreeMem(p);
END;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// 程序开始运行时激活服务器端Socket
Server.Active:=true;
Statusbar1.Panels.Items[0].Text:='服务器启动.主机名:'+Server.Socket.LocalHost+' 监听端口:'+inttostr(Server.Port);
self.Caption:=Statusbar1.Panels.Items[0].Text;
Application.Title:=Statusbar1.Panels.Items[0].Text;
Statusbar1.Panels.Items[1].Text:='在线用户数: '+IntToStr(Server.Socket.ActiveConnections);
end;
procedure TForm1.ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
var
Tempstrchar;
begin
TempStr:=pchar('欢迎登陆服务器 '#13#10);
socket.SendText(TempStr);
TempStr:=pchar('#######################################'+#13#10);
socket.SendText(TempStr);
TempStr:=pchar('你所输入的内容将发送给所有在线用户'+#13#10);
socket.SendText(TempStr);
end;
procedure TForm1.ServerClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
//错误判断
Case ErrorCode Of
10054:Memo1.lines.add('连接被用户重置.');
Else
Memo1.Lines.Add('发生Socket错误,错误代码:'+InttoStr(errorCode));
// 显示错误码
End;
ErrorCode:=0;
end;
procedure TForm1.btnSendClick(Sender: TObject);
var
i:integer;
Count:Integer;
begin
Count:=Server.Socket.ActiveConnections;
for i:=0 to Count-1 do
Server.Socket.Connections.SendText(edtSend.text);
end;
procedure TForm1.ServerClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
Var
Count:Integer;
IDIndex:Integer;
begin
Memo1.Lines.add('用户离线');
Memo1.Lines.add(' SocketID:'+Inttostr(Socket.SocketHandle));
IDIndex:=Combox1.Items.IndexOf( Inttostr(Socket.SocketHandle));
Combox1.Items.Delete(IDIndex);
//该事件在用户离开前发生
Count:=Server.Socket.ActiveConnections-1;
Statusbar1.Panels.Items[1].Text:='在线用户:'+Inttostr(Count);
end;
procedure TForm1.btnOneSendClick(Sender: TObject);
var
ID:Integer;
Socket:TCustomWinSocket;
begin
if Combox1.Text='' then
exit;
ID:=strtoint(Combox1.text);
//用已有的Socket句柄建立socket对象
Socket:=TCustomWinSocket.Create(ID);
Socket.SendText(EdtSend.text);
end;
end.