⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 server.pas

📁 基于delphi的远程控制系统,希望对大家有用
💻 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 + -