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

📄 u_main.~pas

📁 对聊天系统干兴趣软件开发者
💻 ~PAS
字号:
unit u_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Sockets, jpeg, ExtCtrls, Buttons;

type
  Tf_main = class(TForm)
    m_send: TMemo;
    TcpClient1: TTcpClient;
    m_Recv: TMemo;
    TcpServer1: TTcpServer;
    GroupBox1: TGroupBox;
    Image2: TImage;
    b_send: TBitBtn;
    b_clear: TBitBtn;
    Image1: TImage;
    GroupBox4: TGroupBox;
    Label1: TLabel;
    e_remoteHost: TEdit;
    Label2: TLabel;
    e_remotePort: TEdit;
    GroupBox5: TGroupBox;
    e_localPort: TEdit;
    GroupBox6: TGroupBox;
    l_clientName: TListBox;
    b_remoteServ: TBitBtn;
    b_rocalServ: TBitBtn;
    Label3: TLabel;
    l_clientPort: TListBox;
    procedure b_sendClick(Sender: TObject);
    procedure TcpServer1Accept(Sender: TObject;
      ClientSocket: TCustomIpClient);
    procedure b_clearClick(Sender: TObject);
    procedure l_clientNameDblClick(Sender: TObject);
    procedure b_remoteServClick(Sender: TObject);
    procedure b_rocalServClick(Sender: TObject);
    procedure l_clientPortDblClick(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TClientThread = class(TThread)   //线程类
  private
  public
    ListBuffer : TStringList;
    TargetList : TStrings;
    procedure synchAddDataToControl;
    constructor Create(CreatSuspended: Boolean);
    procedure Execute;override;
    procedure Terminate;
  end;

var
  f_main: Tf_main;

implementation

{$R *.dfm}

{线程类TClientThread的构造函数}
constructor TClientThread.Create(CreatSuspended: Boolean);
begin
  inherited Create(CreatSuspended);
  FreeOnTerminate := true;
  ListBuffer := TStringList.Create;
end;

{线程类TClientThread的结束函数}
procedure TClientThread.Terminate;
begin
  ListBuffer.Free;
  inherited;
end;

{线程类TClientThread的执行函数}
procedure  TClientThread.Execute;
begin
  Synchronize(synchAddDataToControl);
end;

{线程类TClientThread的同步函数:把数据从缓冲区发送到TargetList的控件中}
procedure TClientThread.synchAddDataToControl;
begin
  TargetList.AddStrings(ListBuffer);
end;

{发送信息}
procedure Tf_main.b_sendClick(Sender: TObject);
var
  i:Integer;
begin
   TcpClient1.RemoteHost := e_remoteHost.Text;
   TcpClient1.RemotePort := e_remotePort.Text;

   try
    if TcpClient1.Connect then
    begin
      for i:= 0 to m_send.Lines.Count-1 do
      begin
        TcpClient1.Sendln(m_send.Lines[i]);

        m_recv.Lines.Append('^_^本地客户机:localhost(127.0.0.1)');
        m_recv.Lines.Append('<<<<<信息开始');
        m_recv.Lines.Append(m_send.Lines[i]);
        m_recv.Lines.Append('>>>>>信息结束');
      end;
    end
    else
    begin
      m_recv.Lines.Append('无法发送:还没有连接好友!');
      m_recv.Lines.Append('请先连接一个好友,有两种方式:');
      m_recv.Lines.Append('1:在好友列表中双击某个好友名单');
      m_recv.Lines.Append('2:在远程服务器中填写好友的主机和端口号,点击 连接 即可');
    end;
    
    finally
       TcpClient1.Disconnect;
    end;

end;

{服务器控件开始接收信息,显示出来}
procedure Tf_main.TcpServer1Accept(Sender: TObject;
  ClientSocket: TCustomIpClient);
var
  s:string;
  clientThread : TClientThread;
begin
  clientThread := TClientThread.Create(true);
  clientThread.TargetList := m_recv.Lines;
  clientThread.ListBuffer.Add('接收连接');
  clientThread.ListBuffer.Add('^_^远程客户机 : ' + ClientSocket.LookupHostName(ClientSocket.RemoteHost)
    + '(' + ClientSocket.RemoteHost + ')'  );
  clientThread.ListBuffer.Add('<<<<<信息开始');
  s := ClientSocket.Receiveln;
  while s<>'' do
  begin
    clientThread.ListBuffer.Add(s);
    s := ClientSocket.Receiveln;
  end;
  clientThread.ListBuffer.Add('>>>>>信息结束');
  clientThread.Resume;
end;

{清空}
procedure Tf_main.b_clearClick(Sender: TObject);
begin
  m_send.Lines.Clear;
end;

{TcpClient1连接远程服务器}
procedure Tf_main.l_clientNameDblClick(Sender: TObject);
var
  i:integer;
begin
  i := 0 ;
  while ( i< l_clientName.Count) do
  begin
     if l_clientName.Selected[i] then//找到被选中的好友
     begin          
        try
          TcpClient1.RemoteHost := l_clientName.Items.Strings[i];
          TcpClient1.RemotePort := l_clientPort.Items.Strings[i];
          e_remoteHost.Text := TcpClient1.RemoteHost;
          e_remotePort.Text := TcpClient1.RemotePort;
          if TcpClient1.Connect then     //连接
          begin
            m_recv.Lines.Append('成功:已经连接');
            break;
          end;
        finally
          TcpClient1.Disconnect;
        end;
     end;
     i := i+1;
  end;
end;

{TcpClient1连接远程服务器}
procedure Tf_main.b_remoteServClick(Sender: TObject);
var
  i:integer;
begin
  TcpClient1.RemoteHost := e_remoteHost.Text;
  TcpClient1.RemotePort := e_remotePort.Text;

  try
    if TcpClient1.Connect then     //连接
    begin
      //查询好友在列表中的索引
      i := l_clientName.Items.IndexOf(e_remotehost.Text);
      if (i<0) then   //如果找不到,添加到列表中
      begin
         l_clientName.Items.Append(e_remotehost.Text);
         l_clientport.Items.Append(e_remoteport.Text);
         m_recv.Lines.Append('已经添加新好友到列表中');
      end
      else      //已经存在
         m_recv.Lines.Append('该好友已经存在于列表中');
    end;
  finally
     TcpClient1.Disconnect;
  end ;

end;

{启动TcpServer1进行侦听}
procedure Tf_main.b_rocalServClick(Sender: TObject);
begin
  TcpServer1.LocalPort := e_localPort.Text;
  TcpServer1.Open;
  TcpServer1.Active := True;

  m_recv.Lines.Append('本地服务器开始启动侦听');
end;

{TcpClient1连接远程服务器}
procedure Tf_main.l_clientPortDblClick(Sender: TObject);
var
  i:integer;
begin
  i := 0 ;
  while ( i< l_clientPort.Count) do
  begin
     if l_clientPort.Selected[i] then//找到被选中的好友
     begin          
        try
          TcpClient1.RemoteHost := l_clientName.Items.Strings[i];
          TcpClient1.RemotePort := l_clientPort.Items.Strings[i];
          e_remoteHost.Text := TcpClient1.RemoteHost;
          e_remotePort.Text := TcpClient1.RemotePort;
          if TcpClient1.Connect then     //连接
          begin
            m_recv.Lines.Append('成功:已经连接');
            break;
          end;
        finally
          TcpClient1.Disconnect;
        end;
     end;
     i := i+1;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -