📄 server.pas
字号:
unit server;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ScktComp, ImgList, Sockets;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
sb: TStatusBar;
cb: TCheckBox;
Edit1: TEdit;
Button8: TButton;
lv: TListView;
Button9: TButton;
Button10: TButton;
Edit2: TEdit;
Label1: TLabel;
ImageList1: TImageList;
ImageList2: TImageList;
Label2: TLabel;
Label3: TLabel;
scs: TTcpServer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure scsClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure scsAccept(Sender: TObject; Socket: TCustomWinSocket);
procedure scsClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure scsClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Button11Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure sendorder(order:string); // ------
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure lvSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean); //发送指令 //-----
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
count:integer;//在线客户数目
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
if button1.Caption='启动服务' then
begin
if edit2.Text='' then
begin
application.MessageBox('请指定服务器使用的端口号','系统提醒',mb_iconwarning+mb_ok);
edit2.SetFocus;
exit; //提前退出整个过程
end;
scs.Port:=strtoint(edit2.Text);
try
scs.active:=true;
sb.Panels[0].Text:='服务器已经启动,正在等待连接...';
button1.Caption:='停止服务';
lv.Items.Clear;//将列表清空。
count:=0;
except
application.MessageBox('服务器启动失败!','请检查',mb_iconstop+mb_ok);
sb.Panels[0].Text:='服务器无法正常启动,请检查!';
end;
end
else
begin
if lv.Items.Count>0 then
begin
if application.MessageBox('还有客户端在线,强制断开并停止服务吗?','系统询问',mb_iconquestion+mb_yesno)=idyes then
begin
sb.Panels[0].text:='正在断开所有客户端的连接,请稍候...';
for i:=0 to lv.Items.count-1 do
scs.Socket.Connections[i].SendText('ashutdown');//发送断开连接通知,第一个字符无所谓主要是紧跟着的shutdown
count:=0;lv.Items.Clear;
sb.Panels[2].Text:='当前共有:'+inttostr(lv.Items.count)+'台机器在线';
end
end;
scs.Active:=false;
sb.Panels[0].Text:='服务器已经停止服务';
button1.Caption:='启动服务';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
sb.Panels[0].Text:='完成';
end;
procedure TForm1.scsClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
sb.Panels[0].text:=socket.RemoteAddress+'正在试图与本服务器连接...';
end;
procedure TForm1.scsAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
count:=count+1;//已连接的客户端个数加1
lv.Items.Add;
lv.Items[count-1].Caption:=socket.RemoteHost;//将刚连接上来的机器加入到服务器行列
sb.Panels[0].Text:=socket.RemoteAddress+'成功连接到本机';
sb.Panels[2].Text:='当前共有:'+inttostr(lv.Items.Count)+'台机器在线';
end;
procedure TForm1.scsClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j:integer;
begin
for i:=0 to lv.items.Count-1 do
begin
if lv.Items[i].Caption=socket.RemoteHost then
begin
for j:=i to lv.Items.count-2 do
lv.Items[j].Caption :=lv.Items[j+1].Caption;
lv.Items[lv.Items.count-1].Free;
count:=count-1;//在线数减1
break;
end;
end;
sb.Panels[0].Text:=socket.RemoteAddress+'已断开与本机的连接';
sb.Panels[2].Text:='当前共有:'+inttostr(lv.Items.count)+'台机器在线';
end;
procedure TForm1.scsClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
errorstr:string;
begin
if ErrorEvent=eeSend then
errorstr:='发送数据出现错误'
else
if ErrorEvent=eeConnect then
errorstr:='连接失败,无法连接到指定服务器'
else
if ErrorEvent=eeDisconnect then
errorstr:='断开连接失败,暂时无法与服务器断开连接'
else
if ErrorEvent=eeReceive then
errorstr:='接收数据出现错误'
else
if ErrorEvent=eeAccept then
errorstr:='出现错误,与服务建立的连接没有完成'
else
errorstr:='出现未知错误,请检查网络是否正常';
sb.Panels[0].Text:=errorstr;
errorcode:=0; //返回无错,让系统不再有提示
end;
procedure TForm1.Button11Click(Sender: TObject);
var
i:integer;
begin
if lv.SelCount>0 then
begin
for i:=0 to lv.SelCount-1 do
end
else
showmessage('无选择对象');
end;
procedure TForm1.Button12Click(Sender: TObject);
var
i:integer;
begin
lv.UpdateItems(0,lv.items.Count-1);
showmessage(lv.items[1].caption+inttostr(LV.items.count));
end;
procedure Tform1.sendorder(order:string);
var
i,j:integer;
begin
if not scs.Active then //检查服务器是否启动
begin
application.MessageBox('服务器还没有启动服务','系统提醒',mb_iconstop+mb_ok);
exit;
end;
j:=0;
if lv.SelCount<1 then //检查是否选择对象
application.MessageBox('执行操作之前,请先选择好操作对象','系统提醒',mb_iconstop+mb_ok)
else
begin
for i:=0 to lv.Items.Count-1 do
begin
if (lv.Items[i].Selected)or(cb.Checked) then
begin
scs.Socket.Connections[i].SendText(order);
j:=j+1;
end;
if (j>=lv.SelCount)and(not cb.Checked) then
break;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
sendorder('11');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
sendorder('10');
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
sendorder('21');
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
sendorder('20');
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
sendorder('31');
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
sendorder('30');
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
sendorder('41');
end;
procedure TForm1.Button10Click(Sender: TObject);
begin
sendorder('40');
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
sendorder(edit1.text); //调用过程
end;
procedure TForm1.lvSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
sb.Panels[1].Text:='当前共选定'+inttostr(lv.selcount)+'台机器'
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -