main.~pas

一个基于flex开发客户端,delphi开发服务器端的聊天室,可直接在本地机运行.有问题可到http://devgame.5d6d.com讨论

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp;


type
Tclient_record=record
CHandle: integer; //客户端套接字句柄 
CSocket:TCustomWinSocket; //客户端套接字 
CName:string; //客户端计算机名称 
CAddress:string; //客户端计算机IP地址 
CUsed: boolean; //客户端联机标志 
end;
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    Memo1: TMemo;
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    List:Tlist;

    Procedure SendMsg(aname,amsg:String); //给别人发消息
    Procedure SendNotMsg(aname,amsg:String);//给这个人除外的所有人发消息
    Procedure SendAllMsg(amsg:String);
    Procedure SendAllUserInfo;
  public
    { Public declarations }
  end;
const 
CMax=100; //客户端最大连接数
var
  Form1: TForm1;
 // session: array[0..CMax] of client_record; //客户端连接数组
 // Sessions: integer; //客户端连接数
implementation


{$R *.dfm}

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
//var
//  client:Tclient_record;
begin
{  client.CHandle := Socket.SocketHandle ;
  client.CSocket := Socket;
  client.CName := Socket.RemoteHost ;
  client.CAddress := Socket.RemoteAddress ;
  client.CUsed := True; }
  List.Add(Socket);
  Memo1.Lines.Add('客户端 '+Socket.RemoteAddress + ' 已经连接');
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var 
 i:integer;
 aName:String;
begin
aName:='';
try
  for i:=0 to List.Count-1 do
  begin
    if TCustomWinSocket(List.Items[i]).SocketHandle =Socket.SocketHandle then
    begin
      aName:=TCustomWinSocket(List.Items[i]).UserName;
      List.Delete(i);
      Break;
   end;
  end;
except
end;  
//StatusBar.Panels[0].Text :='客户端 '+Socket.RemoteHost + ' 已经断开';
  Memo1.Lines.Add('客户端'+aName+'['+Socket.RemoteAddress + '] 已经断开');
  SendNotMsg(aName,'66'+aName);
//  SendAllUserInfo;
//  SendAllMsg('44当前有'+IntToStr(List.Count)+'人聊天');
end;
Function GetIndexStr(Str,Sign:String;Index:integer):String;
var
  temp,temp2:String;
  i,j:integer;
begin
  temp:=Str+'--';
  i:=POS(Sign,temp);
  j:=0;
  while i>0 do
  begin
    temp2:=COpy(temp,1,i-1);
    temp :=COpy(temp,i+length(Sign),Length(temp)-i);
    inc(j);
    if Index=j then
    begin
      Result:=temp2;
      Break;
    end;
    i:=POS(Sign,temp);
  end;
end;
Function strToCount(a:String):Integer;
begin
  Result:=0;
  if trim(a)='' then exit;
  try
    Result:=StrToInt(a);
  except
  end;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   i,j:integer;
   Str,cmd,msg,xml:String;
   a1,a2,a3,a4:String;
   Buf:array[0..1023] of char;
   Lists:TStringList;
begin
   i:=Socket.ReceiveLength;
   Str:=Socket.ReceiveText;
   if POS('<policy-file-request/>',Str)>0 then
   begin
     Lists:=TStringList.Create;
     Lists.LoadFromFile('socket-policy.xml');
     xml:=Lists.Text;
     Socket.SendText(xml);
     Socket.SendText(#$00);
     Memo1.Lines.Add('send:'+xml);
     Lists.Free;
     exit;
   end;
   Str:=UTF8Decode(Str);
   Memo1.Lines.Add(DateToStr(Date)+' '+TimeToStr(Time)+'收到:'+Str);
   cmd:=Copy(Str,1,2);
   if  cmd='11' then
     msg:=Copy(Str,3,Length(Str))
   else
     msg:=Str;
   a1:=GetIndexStr(msg,'--',1);
   a2:=GetIndexStr(msg,'--',2);
   a3:=GetIndexStr(msg,'--',3);
   if (cmd='33') or (cmd='55') then
   a4:=GetIndexStr(msg,'--',4);
   //Socket.ReceiveBuf(Buf,1024);
  // for j :=0 to i-1 do
  //  Str[j+1]:=buf[j]; 
   if cmd='11' then
   begin
     for i:=0 to List.Count-1 do
     if TCustomWinSocket(List.Items[i]).SocketHandle =Socket.SocketHandle then//取得匹配的客户端
     begin
       TCustomWinSocket(List.Items[i]).UserName:=trim(msg);
       TCustomWinSocket(List.Items[i]).mx :=550;
       TCustomWinSocket(List.Items[i]).my :=315;
     end;
     SendAllUserInfo;
     SendAllMsg('44当前有'+IntToStr(List.Count)+'人聊天');
     //sleep(10);
    // SendAllMsg('22'+msg+'登陆了!');
   end;
   if cmd='22' then
   begin
    // Memo1.Lines.Add('公聊'+a1+a2+'说：'+a3);
     SendAllMsg(a1+a2+'说：'+a3);
   end;
   if cmd='33' then
   begin
   //  Memo1.Lines.Add('公聊'+a1+a2+'说：'+a3);
     if a2='所有人' then
       SendAllMsg('22'+a3+'说：'+a4)
     else begin
       msg:='22（悄悄话）'+a3+'对你说：'+a4;
       SendMsg(trim(a2),msg);
       msg:='22（悄悄话）你对'+a2+'说：'+a4;
       SendMsg(trim(a3),msg);
     end;  
   end;
   if cmd='55' then
   begin
     for i:=0 to List.Count-1 do
     if TCustomWinSocket(List.Items[i]).SocketHandle =Socket.SocketHandle then//取得匹配的客户端
     begin
       TCustomWinSocket(List.Items[i]).mx :=strToCount(a3);
       TCustomWinSocket(List.Items[i]).my :=strToCount(a4);
     end;
   //  Memo1.Lines.Add('公聊'+a1+a2+'说：'+a3);
     SendNotMsg(a2,a1+a2+'--'+a3+'--'+a4);
   end;
end;
Procedure TForm1.SendNotMsg(aname,amsg:String);
var
 i:integer;
begin
  if aname='' then exit;
   for i:=0 to List.Count-1 do
     if TCustomWinSocket(List.Items[i]).UserName<>aname then
     begin
      try
       TCustomWinSocket(List.Items[i]).SendText(amsg);
      except
      end;
       Memo1.Lines.Add(TimeToStr(Time)+'发送给[ '+TCustomWinSocket(List.Items[i]).UserName+']:'+ amsg);
    end;
end;
Procedure TForm1.SendMsg(aname,amsg:String);
var
 i:integer;
begin
   for i:=0 to List.Count-1 do
     if TCustomWinSocket(List.Items[i]).UserName=aname then
     begin
      try
       TCustomWinSocket(List.Items[i]).SendText(amsg);
      except
      end;
       Memo1.Lines.Add(TimeToStr(Time)+'发送给[ '+TCustomWinSocket(List.Items[i]).UserName+']:'+ amsg);
    end;
end;

Procedure TForm1.SendAllMsg(amsg:String);
var
 i:integer;
begin
   for i:=0 to List.Count-1 do
   begin
     try
     TCustomWinSocket(List.Items[i]).SendText(amsg);
     except
     end;
     Memo1.Lines.Add(TimeToStr(Time)+'发送给[ '+TCustomWinSocket(List.Items[i]).UserName+']:'+ amsg);
   end;
end;

Procedure TForm1.SendAllUserInfo;
var
 i:integer;
 str:String;
begin
   Str:='';
   for i:=0 to List.Count-1 do
    Str:=Str+'--'+TCustomWinSocket(List.Items[i]).UserName+','+IntToStr(TCustomWinSocket(List.Items[i]).mx)+','+IntToStr(TCustomWinSocket(List.Items[i]).my);
   SendAllMsg('11'+Str);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  List:=Tlist.Create;
  ServerSocket1.Open;
  Caption:=inttostr(ServerSocket1.port);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ServerSocket1.Close ;
  Memo1.Lines.SaveToFile(FormatDateTime('MMDDHH',now)+'.txt');
  List.Clear;
  List.Free;
end;

end.