unit1.pas

转发一个用Delphi7编写的网络即时通讯示例

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ToolWin, ComCtrls, Menus,unit2, Sockets,unit3,unit6 ;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    CoolBar1: TCoolBar;
    Panel2: TPanel;
    Memo1: TMemo;
    Memo2: TMemo;
    Panel3: TPanel;
    TcpClient1: TTcpClient;
    TcpServer1: TTcpServer;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    N6: TMenuItem;
    SaveDialog1: TSaveDialog;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    Panel1: TPanel;
    Label1: TLabel;
    N10: TMenuItem;
    Panel4: TPanel;
    connect: TButton;
    break: TButton;
    button3: TButton;
    N11: TMenuItem;
    PopupMenu1: TPopupMenu;
    procedure connectClick(Sender: TObject);
    procedure button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TcpServer1Accept(Sender: TObject;
      ClientSocket: TCustomIpClient);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure breakClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure Memo2Click(Sender: TObject);
    procedure Memo2DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
 
{$R *.dfm}
function send(tt:string):string;
begin
form1.TcpClient1.RemoteHost:=form2.edit1.Text;
form1.TcpClient1.RemotePort:=form2.edit2.Text;
form1.tcpclient1.Connect;
if form1.tcpclient1.Connected then
form1.tcpclient1.Sendln(tt);
form1.tcpclient1.Disconnect;
end;

function shaniu(ss:string):string;
var t:string;
begin
if messagedlg('是否允许对方启动傻妞人工智能？',mtinformation,[mbyes,mbNo],0)=mryes
  then
  begin
   showmessage('你已经同意了对方使用傻妞系统！');t:='received';send(t);
  end;
end;


procedure TForm1.connectClick(Sender: TObject);
begin
form1.Hide;
Form2.ShowModal;

end;

procedure TForm1.button3Click(Sender: TObject);

begin
form3.ShowModal;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.text:='';
memo2.text:='';
button3.Enabled:=false;
panel4.Caption:='';

end;

procedure TForm1.TcpServer1Accept(Sender: TObject;
  ClientSocket: TCustomIpClient);
  var s:string;
  begin
  s:=clientsocket.Receiveln;
  if s='do you receive?' then shaniu(s);
  if s='received' then  form6.ShowModal;
  if s<>'' then
  memo1.Lines.Add(clientSocket.RemoteHost);
 { while s<>'' do
  if s='<br>' then
  memo1.Lines.Add('');
  }
  memo1.Lines.Add(s);
  s:=clientsocket.Receiveln;
end;



procedure TForm1.N3Click(Sender: TObject);
begin
connect.Click;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
break.Click;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
if messagedlg('是否真的要退出聊天程序？',mtinformation,[mbyes,mbNo,mbcancel],0)=mryes
then close;
end;

procedure TForm1.breakClick(Sender: TObject);
begin
if messagedlg('是否真的要断开连接？',mtinformation,[mbyes,mbNo,mbcancel],0)=mryes
then
begin
tcpclient1.Active:=false;
tcpserver1.Active:=false;
button3.Enabled:=false;
statusbar1.Panels[1].Text:= '已断开';
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var aa:tdatetime;
begin
aa:=now;
statusbar1.Panels[0].Text:='当前时间:'+timetostr(aa);
end;

procedure TForm1.N6Click(Sender: TObject);
var s:string;
begin
savedialog1.Execute;
statusbar1.Panels[1].Text:='保存当前聊天纪录';
s:=savedialog1.FileName;
if extractfileext(s)<>'.txt'
then s:=s+'.txt';
 memo1.Lines.SaveToFile(s);
end;

procedure TForm1.N7Click(Sender: TObject);
begin
 showmessage('一个简单的聊天程序，版权所有王井锋');
end;

procedure TForm1.N9Click(Sender: TObject);
var request:string;
begin
request:='do you receive?';
if messagedlg('是否启动傻妞人工智能？',mtinformation,[mbyes,mbNo],0)=mryes
then
begin
send(request);
statusbar1.Panels[1].Text:='傻妞代你询问中...';
end;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
panel4.Visible:=false;
end;

procedure TForm1.Memo2Click(Sender: TObject);
begin
panel4.Visible:=false;
end;

procedure TForm1.Memo2DblClick(Sender: TObject);
begin
panel4.Visible:=true;
end;

end.