unit1.pas

用Delphi写的网络聊天工具

                   UserInfoList.Strings[5],//Sex
                   UserInfoList.Strings[2],//Host
                   UserInfoList.Strings[3],//Address
                   UserInfoList.Strings[4],//ImageInedx
                   UserInfoList.Strings[0],//ID
                   UserInfoList.Strings[1],//UserName
                   UserRemark[i]);//Remark
            break;
          end;
        UserInfoList.Free;
      end;
    Ord('L')://客户登录取密码校念,发送到客户时用户名后必须跟Sex
      begin
        for i:=0 to s.Socket.ActiveConnections-1 do
          SendBy(s.Socket.Connections[i],'?','','','','','','','');
        sleep(1000);
        ClearOffUser;  //检查该用户是否掉线
        sleep(1000);

        if (Session.Param1='?') or (Session.Param2='?') then
          SendBy(s.Socket.Connections[GetIndexbyHandle(Socket.SocketHandle)],
            'F','','服务器验证失败！','','','','','')
        else
        begin
          Chat.RealTemp.Close;
          Chat.RealTemp.SQL.Clear;
          Chat.RealTemp.SQL.Text:='select 1 from UserInfo'+#13+
                                  'where ID=:ID and Deleted=1';
          Chat.RealTemp.Parameters[0].Value:=Session.Param1;
          Chat.RealTemp.Open;
          if not Chat.RealTemp.IsEmpty then//检查帐号是否禁用
          begin
            SendBy(s.Socket.Connections[GetIndexbyHandle(Socket.SocketHandle)],
              'F','','帐号已被禁用！','','','','','');
            exit;
          end;

          if SelectUser(Session.Param1,Session.Param2,1,1,1,UserName,Sex) then
          begin
            UpUser(Socket.SocketHandle,Session.Param1,Session.Param3,Session.Param4,1);
            GetUserList(Socket.SocketHandle,Session.Param1,UserName,Sex); //客户取得用户列表
            SendAllUser(Socket.SocketHandle,UserName,Sex,'1','0',Session.Param1);//通知其它客户本人上线Logined=1上线Logined=0下线
            ListBox1.Items.Add(Session.Param1+'('+UserName+')');
            label1.Caption :='在线用户列表('+inttostr(ListBox1.Items.Count)+'人)';

            UserInfoList:=TStringList.Create;  //由于用户登陆会改IP和主机，要刷新UserList
            for i:=0 to UserList.Count-1 do
              if Session.Param1=GetTextID(UserList.Strings[i],';') then
              begin
                StrtoList(UserList.Strings[i],UserInfoList);
                UserInfoList.Strings[2]:=Session.Param3;//Host
                UserInfoList.Strings[3]:=Session.Param4;//Address
                break;
              end;
            UserList.Strings[i]:=StringsToStr(UserInfoList.Text,';');
            UserInfoList.Free;
          end
          else
            SendBy(s.Socket.Connections[GetIndexbyHandle(Socket.SocketHandle)],
              'F','','服务器验证失败！','','','','','');
        end;
        BrowseUser;
      end;
    Ord('R')://客户注册时返回用户列表;
      begin
        i:=GetIndexByHandle(Socket.SocketHandle);
        try
          ID:=NewID(Socket.SocketHandle);
          InsUser(ID,Session.Param1,Session.Param4,Session.Param6,Socket.RemoteAddress,
            Socket.SocketHandle,1,strtoint(Session.Param3),Session.Param5,
            strtoint(Session.Handle));
          UserList.Add(ID+';'+
                       Session.Param1+';'+
                       Session.Param6+';'+
                       Socket.RemoteAddress+';'+
                       Session.Handle+';'+
                       Session.Param3+';'+
                       Session.Handle);
          setlength(UserRemark,high(UserRemark)+2);
          UserRemark[high(UserRemark)]:=Session.Param5;

          SendBy(s.Socket.Connections[i],'S',Session.Handle,ID,inttostr(Socket.SocketHandle),'','','','');

          UpUser(Socket.SocketHandle,Session.Param1,Session.Param6,Socket.RemoteAddress,1);

          //GetUserList(Socket.SocketHandle,ID,Session.Param1,Session.Param3);
          //SendAllUser(Socket.SocketHandle,Session.Param1,Session.Param3,'1','1',ID);
          ListBox1.Items.Add(ID+'('+Session.Param1+')');
          label1.Caption :='在线用户列表('+inttostr(ListBox1.Items.Count)+'人)';
        except
          SendBy(s.Socket.Connections[i],'E','','','','','','','');
        end;
        BrowseUser;
      end;
    Ord('C')://客户退出时返回用户列表
      begin
        UpUser(Socket.SocketHandle,Session.Param3,Session.Param4,Session.Param5,0);
        SendAllUser(Socket.SocketHandle,Session.Param1,Session.Param2,'0','0',Session.Param3);
        i:=ListBox1.Items.IndexOf(Session.Param3+'('+Session.Param1+')');
        ListBox1.Items.Delete(i);
        label1.Caption :='在线用户列表('+inttostr(ListBox1.Items.Count)+'人)';
        BrowseUser;
      end;
    Ord('T')://转发客户之间的交流
      begin
        SelectUser(session.Param4,'A',0,0,1,UserName,Sex);
        i:=GetIndexByHandle(strtoint(Session.Handle));
        if (chat.qryUserLogined.AsInteger=1) then
        begin
          SelectUser(session.Param3,'A',0,0,1,UserName,Sex);
          SendBy(s.Socket.Connections[i],'T',inttostr(chat.qryUserHandle.Value),
          Session.Param1,Session.Param2,Session.Param3,'1',
          Session.Param4,inttostr(byte(chat.qryUserSex.Value)));
        end
        else
        begin
          SelectUser(session.Param3,'A',0,0,1,UserName,Sex);
          SendBy(s.Socket.Connections[i],'T',inttostr(chat.qryUserHandle.Value),
          Session.Param1,Session.Param2,Session.Param3,'0',
          Session.Param4,inttostr(byte(chat.qryUserSex.Value)));
        end
      end;
    Ord('A')://广播
      begin
        SelectUser(session.Param4,'A',0,0,1,UserName,Sex);
        if chat.qryUserLogined.AsInteger=1 then
        begin
          chat.RealTemp.Close;
          chat.RealTemp.SQL.Clear;
          chat.RealTemp.SQL.Add('select distinct u.Handle,u.Logined from UserInfo u,Groups g');
          chat.RealTemp.SQL.Add('where (g.SubID='''+session.Param3+''' and u.ID=g.ID)');
          chat.RealTemp.SQL.Add('or (u.ID='''+session.Param4+''' and u.ID=g.SubID)');
          //chat.RealTemp.SQL.Add('where g.ID='''+session.Param3+'''');
          //chat.RealTemp.SQL.Add('and u.ID=g.SubID');
          chat.RealTemp.Open;
          if not chat.RealTemp.IsEmpty then
          begin
            while not chat.RealTemp.Eof do
            begin
              if chat.RealTemp.Fields[1].Value=1 then
              begin
                i:=GetIndexByHandle(chat.RealTemp.Fields[0].Value);
                SendBy(s.Socket.Connections[i],'A',inttostr(Socket.SocketHandle),
                Session.Param1,Session.Param2,Session.Param3,'1',
                Session.Param4,'')
              end;
              chat.RealTemp.Next;
            end;
          end;
          chat.RealTemp.Close;
          for i:=0 to s.Socket.ActiveConnections-1 do
            if (s.Socket.Connections[i].SocketHandle<>Socket.SocketHandle) then
              SendBy(s.Socket.Connections[i],'A',inttostr(Socket.SocketHandle),
              Session.Param1,Session.Param2,Session.Param3,'1',
              Session.Param4,'')
        end
        else
        begin
          SelectUser(session.Param3,'A',0,0,1,UserName,Sex);
          SendBy(Socket,'T',inttostr(chat.qryUserHandle.Value),
          Session.Param1,Session.Param2,Session.Param3,'0',
          Session.Param4,'');
        end;
      end;
  end;
  Dispose(RecText);
end;

function TForm1.GetIndexByHandle(Handle: integer):integer;
var
  i:integer;
begin
  Result:=0;
  for i:=0 to s.Socket.ActiveConnections-1 do
  begin
    if s.Socket.Connections[i].SocketHandle=Handle then
    begin
      Result:=i;
      Break;
    end;
  end;
end;

procedure TForm1.sClientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  if ErrorCode=10053 then
    ErrorCode:=0
  else if ErrorCode=10054 then//用户异常退出
  begin
    ErrorCode:=0;
  end
  else if ErrorCode=10048 then
  begin
    MessageBox(Handle,'端口被占。','提示',MB_OK);
    ErrorCode:=0;
  end;
end;

procedure TForm1.SendBy(cs:TCustomWinSocket;Msg, Handle, Param1, Param2, Param3, Param4, Param5, Param6: string);
var
  s:string;
begin
  if Msg='' then Msg:='';
  if Handle='' then Handle:='';
  if Param1='' then Param1:='';
  if Param2='' then Param2:='';
  if Param3='' then Param3:='';
  if Param4='' then Param4:='';
  if Param5='' then Param5:='';
  if Param6='' then Param6:='';
  s:=Msg+#255+Handle+#255+Param1+#255+Param2+#255+Param3+#255+Param4+#255+Param5+#255+Param6;
  cs.SendText(s);
end;

procedure TForm1.InsUser(ID, UserName, PasswordA, Host, Address: string;
  Handle: integer; Logined, Sex: integer; Remark: string;ImageIndex:integer);
begin
  chat.InsUser.Parameters.ParamByName('ID').Value:=ID;
  chat.InsUser.Parameters.ParamByName('UserName').Value:=UserName;
  chat.InsUser.Parameters.ParamByName('PasswordA').Value:=PasswordA;
  chat.InsUser.Parameters.ParamByName('Host').Value:=Host;
  chat.InsUser.Parameters.ParamByName('Address').Value:=Address;
  chat.InsUser.Parameters.ParamByName('Handle').Value:=Handle;
  chat.InsUser.Parameters.ParamByName('Logined').Value:=Logined;
  chat.InsUser.Parameters.ParamByName('Sex').Value:=Sex;
  chat.InsUser.Parameters.ParamByName('Remark').Value:=Remark;
  chat.InsUser.Parameters.ParamByName('ImageIndex').Value:=ImageIndex;
  chat.InsUser.ExecSQL;
end;

function TForm1.SelectUser(ID, PasswordA: string;a,b,c:integer;var UserName,Sex:string):Boolean;
begin
  {$IFDEF VER140}
  chat.qryUser.Close;//D6 Use
  {$ENDIF}
  chat.qryUser.Parameters.ParamByName('a').Value:=a;
  chat.qryUser.Parameters.ParamByName('b').Value:=b;
  chat.qryUser.Parameters.ParamByName('c').Value:=c;
  chat.qryUser.Parameters.ParamByName('ID').Value:=ID;
  chat.qryUser.Parameters.ParamByName('PasswordA').Value:=PasswordA;
  chat.qryUser.Open ;
  {$IFDEF VER130}
  chat.qryUser.Requery([]);//D5 Use
  {$ENDIF}
  UserName:=chat.qryUserUserName.AsString;
  Sex:=chat.qryUserSex.AsString;
  if not chat.qryUser.IsEmpty then
    result:=true
  else
    result:=false;
end;

procedure TForm1.UpUser(Handle:integer;ID,Host,Address:string;Logined:integer);
begin
  if not chat.Con.Connected then
    chat.Con.Open;
  chat.UpUser.Parameters.ParamByName('Logined').Value:=Logined;
  chat.UpUser.Parameters.ParamByName('ID').Value:=ID;
  chat.UpUser.Parameters.ParamByName('Handle').Value:=Handle;
  chat.UpUser.Parameters.ParamByName('Host').Value:=Host;
  chat.UpUser.Parameters.ParamByName('Address').Value:=Address;
  chat.UpUser.ExecSQL;
end;

procedure TForm1.GetUserList(Handle:integer;ID,UserName,Sex:string);
var
  HandleStr:string;
  UserNameStr:string;
  LoginedStr:string;
  SexStr:string;
  IDStr:string;
  i:integer;
begin
  i:=GetIndexByHandle(Handle);
  chat.qryTemp.Parameters.ParamByName('ID').Value:=ID;
  chat.qryTemp.Open ;
  chat.qryTemp.Requery([]);

  if not chat.qryTemp.IsEmpty then
  begin
    while not chat.qryTemp.Eof do
    begin
      HandleStr:=HandleStr+inttostr(chat.qryTempHandle.Value)+#13;
      UserNameStr:=UserNameStr+chat.qryTempUserName.Value+#13;
      LoginedStr:=LoginedStr+inttostr(byte(chat.qryTempLogined.Value))+#13;
      SexStr:=SexStr+inttostr(byte(chat.qryTempSex.Value))+#13;
      IDStr:=IDStr+chat.qryTempID.Value+#13;
      chat.qryTemp.next;
    end;
  end;

  SendBy(s.Socket.Connections[i],'L',inttostr(Handle),
    UserNameStr,LoginedStr,SexStr,HandleStr,UserName+Sex,IDStr);
end;

procedure TForm1.SendAllUser(Handle: integer; UserName, Sex, Logined, Registered,ID: string);
var
  i:integer;
  FQuery:TADOQuery;
  ss:string;
begin
  FQuery:=TADOQuery.Create(nil);
  try
    FQuery.Connection :=Chat.Con;
    FQuery.SQL.Add('select Handle from UserInfo u,Groups g where u.Logined=1');
    if Logined='0' then
    begin
      FQuery.SQL.Add('and u.ID=g.ID and g.SubID='''+ID+'''');
      //FQuery.SQL.Add('and (u.ID=g.SubID and g.ID='''+ID+'''');
      //FQuery.SQL.Add('and g.SubID in (select ID from Groups where SubID='''+ID+'''))');
      //FQuery.SQL.Add('or ((u.ID=g.ID) and (g.SubID='''+ID+'''))');
    end
    else
    begin
      FQuery.SQL.Add('and u.ID=g.ID and g.SubID='''+ID+'''');
    end;

    ss:=FQuery.SQL.Text;
    FQuery.Open;

    for i:=0 to s.Socket.ActiveConnections-1 do
    begin
      if FQuery.Locate('Handle',s.Socket.Connections[i].SocketHandle,[])
        and (s.Socket.Connections[i].SocketHandle<>Handle) then
        SendBy(s.Socket.Connections[i],
          'G',inttostr(Handle),UserName,Sex,Logined,Registered,ID,'');
    end;
    FQuery.Close;
  finally
    FQuery.Free;
  end;
end;

procedure TForm1.GetUserInfoByID(ID: String);
begin
  Chat.Temp.close;
  Chat.Temp.SQL.Clear ;
  Chat.Temp.SQL.Add('select ID,UserName,Sex,Remark,ImageIndex from UserInfo');
  Chat.Temp.SQL.Add('where ID='''+ID+'''');
  Chat.Temp.open;
  //Chat.Temp.Requery([]);
end;

procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Offset: Integer;
  Bitmap:TBitmap;
begin
  Bitmap:=nil;
  if (Control as TListBox).Name='ListBox2' then
    Bitmap:=image1.Picture.Bitmap
  else if (Control as TListBox).Name='ListBox1' then
    Bitmap:=image2.Picture.Bitmap;

  with (Control as TListBox).Canvas do
  begin
    FillRect(Rect);
    Offset := 1;
    if Bitmap<>nil then
    begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top, Bitmap.Width, Bitmap.Height),
              Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), RGB(255,0,255));
      Offset := Bitmap.width + 6;
    end;
    TextOut(Rect.Left+Offset, Rect.Top+1, (Control as TListBox).Items[Index])
  end;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

procedure TForm1.E1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  ID:string;
  i:integer;
begin
  if ListBox1.ItemIndex<>-1 then
  begin
    ID:=GetTextID(ListBox1.Items.Strings[ListBox1.ItemIndex],'(');
    if selectUser(ID,'A',0,0,1,UserName,Sex) then
    begin
      i:=GetIndexByHandle(Chat.qryUserHandle.AsInteger);
      SendBy(s.Socket.Connections[i],'admin','0','Admin'+'('+datetimetoStr(Now)+'): '+#13#10+'  '+Memo2.Lines.Text,