unit1.pas

用Delphi写的网络聊天工具

unit Unit1;

interface

uses
  winsock,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp,GeneralSource, ExtCtrls, Grids, DBGrids, Db, ADODB,
  Buttons, Menus, ImgList, ToolWin, ComCtrls, ActnList, AppEvnts,
  RzTray, RzCommon;

const
  UM_RESTORE_APPLICATION=WM_User+101;

type
  TSession=Record
    Msg:string;
    Handle:string;
    Param1:string;
    Param2:string;
    Param3:string;
    Param4:string;
    Param5:string;
    Param6:string;
  end;

  TForm1 = class(TForm)
    s: TServerSocket;
    Image1: TImage;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Label1: TLabel;
    Splitter2: TSplitter;
    ListBox2: TListBox;
    Image2: TImage;
    ListBox1: TListBox;
    Panel5: TPanel;
    Panel6: TPanel;
    Memo1: TMemo;
    Panel7: TPanel;
    Memo2: TMemo;
    MainMenu1: TMainMenu;
    N11: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    B1: TMenuItem;
    S1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    E1: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    U1: TMenuItem;
    ImageList1: TImageList;
    ActionList1: TActionList;
    Timer1: TTimer;
    N10: TMenuItem;
    StatusBar1: TStatusBar;
    Splitter3: TSplitter;
    Label2: TLabel;
    Panel8: TPanel;
    BitBtn3: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    Panel9: TPanel;
    Label3: TLabel;
    G1: TMenuItem;
    ControlBar1: TControlBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton9: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolBar2: TToolBar;
    RzTrayIcon1: TRzTrayIcon;
    Action1: TAction;
    ini: TRzRegIniFile;
    procedure sClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure sClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ListBox2DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure BitBtn3Click(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure U1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure B1Click(Sender: TObject);
    procedure G1Click(Sender: TObject);
  private
    { Private declarations }
    UserName,Sex:string;
    procedure UpUser(Handle:integer;ID,Host,Address:string;Logined:integer);
    function SelectUser(ID,PasswordA:string;a,b,c:integer;var UserName,Sex:string):Boolean;
    procedure GetUserList(Handle:integer;ID,UserName,Sex:string);
    procedure GetUserList1(Handle:integer;ID,SearchID, SearchName:string);
    procedure GetUserInfoByID(ID:String);
    procedure ClearOffUser;
    function GetTextID(Text: string; BreakSymbol: string = '.'): string;
    function GetTextName(Text: string; BreakSymbol: string = '.'): string;
    procedure UMRestoreApplication(var Message : TMessage); message UM_RESTORE_APPLICATION;
    procedure StrToList(Str: string; var List: TStrings;BreakSymbol: string = ';');
    function StringsToStr(Str: string;BreakSymbol: string = ';'): string;
    procedure WMQueryEndSession(var Msg: TMessage);message WM_QueryEndSession;
    procedure CloseTheInstance;
    procedure ReturnGameCommand(MyHandle,UserHandle,CommandStr,Param1,Param2,Param4,Param5:string);
  public
    { Public declarations }
    RecText:PPs;
    Logined:Boolean;
    Locked:Boolean;
    UserList:Tstrings;
    UserRemark:array of string;
    CommandStr:string;

    function NewID(Handle:integer=0):string;
    procedure UpdateState;
    procedure SendAllUser(Handle:integer;UserName,Sex,Logined,Registered,ID:string);
    procedure InsUser(ID:string;UserName,PasswordA,Host,Address:string;
      Handle:integer;Logined,Sex:integer;Remark:string;ImageIndex:integer);
    procedure BrowseUser;
    function GetIndexByHandle(Handle:integer):integer;
    procedure SendBy(cs:TCustomWinSocket;Msg,Handle,Param1,Param2,Param3,Param4,Param5,Param6:string);       
  end;

var
  Form1: TForm1;

implementation

uses ChatSource, Unit2, Unit3, Unit4, Unit5, Unit7;

{$R *.DFM}

procedure xx(n,s:string);
var
  Txtfile:TextFile;
begin
  Assignfile(Txtfile,n);
  if fileExists(n) then
    Append(Txtfile)
  else
    Rewrite(Txtfile);
  try
    writeln(Txtfile,s);
  finally
    closefile(Txtfile);
  end;
end;

function TForm1.GetTextID(Text: string; BreakSymbol: string = '.'): string;
var
  I: Integer;
begin
  I := Pos(BreakSymbol, Text);
  if I > 0 then
    Result := Copy(Text, 1, I - 1)
  else Result := Text;
end;

function TForm1.GetTextName(Text: string; BreakSymbol: string = '.'): string;
var
  I: Integer;
begin
  I := Pos(BreakSymbol, Text);
  if I > 0 then
    Result := Copy(Text, I + Length(BreakSymbol),
      Length(Text) - I - Length(BreakSymbol) + 1)
  else Result := Text;
end;

procedure TForm1.sClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  Tmps:String;
  i:integer;
  ID:string;
  Txtfile:TextFile;
  UserInfoList:TStrings;
  Session:TSession;
  MyHandle,UserHandle,Param1,Param2,Param4,Param5:string;
begin
  Tmps:=Socket.ReceiveText;
  RecText:=nil;
  RecText:=GetSession(Pchar(Tmps),7);
  Session.Msg:=RecText^[0];
  Session.Handle:=RecText^[1];
  Session.Param1:=RecText^[2];
  Session.Param2:=RecText^[3];
  Session.Param3:=RecText^[4];
  Session.Param4:=RecText^[5];
  Session.Param5:=RecText^[6];
  Session.Param6:=RecText^[7];

  if Session.Msg<>'T' then
    if Session.Msg<>'A' then
    begin
      ListBox2.Items.Add(DateTimetoStr(Now)+'   '+Tmps);
      Assignfile(Txtfile,'Sys.log');
      if fileExists('Sys.log') then
        Append(Txtfile)
      else
        Rewrite(Txtfile);
      try
        writeln(Txtfile,ListBox2.Items.Strings[ListBox2.Items.Count-1]);
      finally
        closefile(Txtfile);
      end;
      if ListBox2.Items.Count =21 then
        ListBox2.Items.Delete(0);
    end;

  if Session.Msg='admin' then
  begin
    Memo1.Lines.Add(Session.Param1);
    SendMessage(Memo1.Handle,EM_SCROLL,SB_BOTTOM,0);
    flashwindow(Application.handle,true);
  end;

  case Ord(Session.Msg[1]) of
    Ord('W')://添加好友
    begin
      chat.RealTemp.Close;
      chat.RealTemp.SQL.Clear;
      chat.RealTemp.SQL.Add('insert into Groups(ID,SubID)');
      chat.RealTemp.SQL.Add('values('+''''+Session.Param1+''','''+Session.Param2+''''+')');
      chat.RealTemp.ExecSQL;
      SelectUser(session.Param2,'A',0,0,1,UserName,Sex);
      if Session.Param5='1' then
      begin
        SendBy(Socket,'G',inttostr(chat.qryUserHandle.Value),
          Session.Param3,Session.Param4,Session.Param5,'1',Session.Param2,'1')
      end
      else
      begin
        SendBy(Socket,'G',inttostr(chat.qryUserHandle.Value),
          Session.Param3,Session.Param4,Session.Param5,'2',Session.Param2,'1')
      end;    //通知自己已添加好友
    end;
    Ord('G')://查找用户
    begin
      GetUserList1(Socket.SocketHandle,Session.Param1,Session.Param2,Session.Param3); //客户取得用户列表
    end;
    Ord('J')://中断游戏
      begin
        i:=GetIndexbyHandle(strtoint(Session.Param3));
        SendBy(s.Socket.Connections[i],'J',Session.Handle,Session.Param2,'','','','','');
      end;
    Ord('P')://开始 游戏(测试)
      begin
        MyHandle:=Session.Param3;
        UserHandle:=Session.Handle;
        Param1:=Session.Param1;
        Param2:=Session.Param2;
        Param4:=Session.Param4;
        Param5:=Session.Param5;
        CommandStr:=CommandStr+Session.Param6+#13;
        ReturnGameCommand(MyHandle,UserHandle,CommandStr,Param1,Param2,Param4,Param5);
        MyHandle:='';
        UserHandle:='';
        CommandStr:='';
        Param1:='';
        Param2:='';
        Param4:='';
        Param5:='';
      end;
    Ord('V')://接受游戏
      begin
        i:=GetIndexbyHandle(strtoint(Session.Param3));
        SendBy(s.Socket.Connections[i],'V',Session.Param1,Session.Param2,Session.Param3,Session.Param4,'',Session.Param5,'');
      end;
    Ord('K')://拒绝游戏
      begin
        i:=GetIndexbyHandle(strtoint(Session.Param4));
        SendBy(s.Socket.Connections[i],'K',Session.Param1,Session.Param2,Session.Param3,'','',Session.Param5,'');
      end;
    Ord('I'):// 询问游戏是否开始
      begin
        SelectUser(session.Param4,'A',0,0,1,UserName,Sex);
        i:=GetIndexbyHandle(strtoint(Session.Handle));
        SendBy(s.Socket.Connections[i],'I',Session.Param2,Session.Param1,Session.Param3,Session.Param4,Session.Param2,inttostr(byte(chat.qryUserLogined.Value)),'');
      end;
    Ord('D')://清除掉线用户
      begin
        ClearOffUser;
        BrowseUser;
      end;
    Ord('N')://文件传输失败
      begin
        i:=GetIndexbyHandle(strtoint(Session.Param3));
        SendBy(s.Socket.Connections[i],'N',Session.Handle,Session.Param2,'','','','','');
      end;
    Ord('Y')://取消接收文件
      begin
        i:=GetIndexbyHandle(strtoint(Session.Param4));
        SendBy(s.Socket.Connections[i],'Y',Session.Param1,Session.Param2,Session.Param3,'','',Session.Param5,'');
      end;
    Ord('O')://用户确认接收文件
      begin
        i:=GetIndexbyHandle(strtoint(Session.Param2));
        SendBy(s.Socket.Connections[i],'C',Session.Param2,Session.Param1,Session.Param3,Session.Handle,'','','');
      end;
    Ord('S')://传输文件
      begin
        i:=GetIndexbyHandle(strtoint(Session.Handle));
        SendBy(s.Socket.Connections[i],'Q',Session.Param2,Session.Param1,Session.Param3,Session.Param4,Session.Param2,'','');
      end;
    Ord('M')://测试连接
      begin
        i:=GetIndexbyHandle(Socket.SocketHandle);
        SendBy(s.Socket.Connections[i],'M','','','','','','','');
      end;
    Ord('X')://修改个人记录
      begin
        Chat.UpTemp.Close ;
        Chat.UpTemp.SQL.Clear ;
        Chat.UpTemp.SQL.Add('Update UserInfo');
        Chat.UpTemp.SQL.Add('Set UserName='''+Session.Param1+'''');
        Chat.UpTemp.SQL.Add(',Sex='+Session.Param2);
        Chat.UpTemp.SQL.Add(',PasswordA='''+GetTextName(Session.Param3)+'''');
        Chat.UpTemp.SQL.Add(',ImageIndex='+Session.Param4);
        Chat.UpTemp.SQL.Add(',Remark='''+Session.Param5+'''');
        Chat.UpTemp.SQL.Add('Where ID='''+Session.Param6+'''');
        Chat.UpTemp.SQL.Add('and PasswordA='''+GetTextID(Session.Param3)+'''');
        Chat.UpTemp.ExecSQL;

        if Chat.UpTemp.RowsAffected=1 then
        begin
          for i:=0 to UserList.Count-1 do
            if Session.Param6=GetTextID(UserList.Strings[i],';') then
            begin
              Chat.UpTemp.SQL.Clear;
              Chat.UpTemp.SQL.Add('Select Host,Address,Handle from UserInfo');
              Chat.UpTemp.SQL.Add('where ID='''+Session.Param6+'''');
              Chat.UpTemp.Open;
              UserList.Strings[i]:=Session.Param6+';'+
                                   Session.Param1+';'+
                                   Chat.UpTemp.Fields[0].Text+';'+
                                   Chat.UpTemp.Fields[1].Text+';'+
                                   Session.Param4+';'+
                                   Session.Param2+';'+
                                   Chat.UpTemp.Fields[2].Text;
              UserRemark[i]:=Session.Param5;
              Chat.UpTemp.Close;
              Break;
            end;
          i:=GetIndexbyHandle(Socket.SocketHandle);
          SendBy(s.Socket.Connections[i],'X','','','','','','','');
        end
        else
        begin
          i:=GetIndexbyHandle(Socket.SocketHandle);
          SendBy(s.Socket.Connections[i],'X','','Error','','','','','');
        end;
        i:=ListBox1.Items.IndexOf(Session.Param6+'('+Session.Handle+')');
        ListBox1.Items.Strings[i]:=Session.Param6+'('+Session.Param1+')'
      end;
    Ord('B')://取得本人信息
      begin
        i:=GetIndexbyHandle(Socket.SocketHandle);
        GetUserInfoByID(Session.Param1);
        SendBy(s.Socket.Connections[i],'B','',Chat.Temp.fieldbyname('UserName').AsString,
               Chat.Temp.fieldbyname('ID').AsString,
               Chat.Temp.fieldbyname('ImageIndex').AsString,
               Chat.Temp.fieldbyname('Sex').AsString,
               Chat.Temp.fieldbyname('Remark').AsString,'');
        Chat.Temp.Close ;
      end;
    Ord('U')://返回聊天用户信息
      begin
        tag:=GetIndexbyHandle(strtoint(Session.Handle));
        UserInfoList:=TStringList.Create;
        for i:=0 to UserList.Count-1 do
          if Session.Param2=GetTextID(UserList.Strings[i],';') then
          begin
            StrtoList(UserList.Strings[i],UserInfoList);
            SendBy(s.Socket.Connections[tag],'U',