unit1.pas

用Delphi写的网络聊天工具

        '','','','','');
      memo1.Lines.Add('Admin'+'('+datetimetoStr(Now)+'): '+#13#10+'  '+Memo2.Lines.Text);
      SendMessage(memo1.Handle,EM_SCROLL,SB_BOTTOM,0);
      Memo2.Lines.Clear;
    end;
  end
  else
    showmessage('请选择用户！');
end;

procedure TForm1.ClearOffUser;
var
  i:integer;
  ConnectCount:integer;
begin
  Chat.qryOffUser.Open ;

  while not Chat.qryOffUser.Eof do
  begin
    ConnectCount:=0;
    for i:=0 to s.Socket.ActiveConnections-1 do
      if Chat.qryOffUser.Fields[0].AsInteger<>s.Socket.Connections[i].SocketHandle then
        inc(ConnectCount);

    if (ConnectCount=s.Socket.ActiveConnections) then
    begin
      Chat.UpTemp.Close ;
      Chat.UpTemp.SQL.Clear ;
      Chat.UpTemp.SQL.Add('Update UserInfo');
      Chat.UpTemp.SQL.Add('Set Logined=0');
      Chat.UpTemp.SQL.Add('Where ID='''+Chat.qryOffUser.Fields[1].AsString+'''');
      Chat.UpTemp.ExecSQL;

      for i:=ListBox1.Items.Count-1 downto 0 do
        if Chat.qryOffUser.Fields[1].AsString=GetTextID(ListBox1.Items.Strings[i],'(') then
          ListBox1.Items.Delete(i);

      SendAllUser(Chat.qryOffUser.Fields[0].AsInteger,Chat.qryOffUser.Fields[2].AsString,
                  Chat.qryOffUser.Fields[3].AsString,'0','0',Chat.qryOffUser.Fields[1].AsString);
    end;
    Chat.qryOffUser.next;
  end;
  Chat.qryOffUser.Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i:integer;
begin
  for i:=s.Socket.ActiveConnections-1 downto 0 do
    SendBy(s.Socket.Connections[i],'','','','','','','','');
  ClearOffUser;
end;

procedure TForm1.N10Click(Sender: TObject);
var
  i:integer;
begin
  for i:=s.Socket.ActiveConnections-1 downto 0 do
    SendBy(s.Socket.Connections[i],'','','','','','','','');
  sleep(1);  
  ClearOffUser;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  if not assigned(form2) then
  begin
    form2:=TForm2.Create(self);
    form2.ShowModal ;
  end;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
  if not assigned(PasswordDlg) then
  begin
    PasswordDlg:=TPasswordDlg.Create(self);
    PasswordDlg.ShowModal ;
  end;
end;

procedure TForm1.UpdateState;
begin
  if Logined then
  begin
    N9.ImageIndex :=1;
    ToolButton1.ImageIndex :=1;
    StatusBar1.Panels[0].Text :='状态:已登录';
    U1.ImageIndex :=2;
    N1.ImageIndex :=4;
    N2.ImageIndex :=6;
    B1.ImageIndex :=8;
    N10.ImageIndex :=11;
    N4.ImageIndex :=13;
    ToolButton2.ImageIndex :=2;
    ToolButton4.ImageIndex :=4;
    ToolButton5.ImageIndex :=6;
    ToolButton6.ImageIndex :=8;
    ToolButton9.ImageIndex :=11;
  end
  else
  begin
    N9.ImageIndex :=0;
    ToolButton1.ImageIndex :=0;
    StatusBar1.Panels[0].Text :='状态:未登录';
    U1.ImageIndex :=3;
    N1.ImageIndex :=5;
    N2.ImageIndex :=7;
    B1.ImageIndex :=9;
    N10.ImageIndex :=12;
    N4.ImageIndex :=14;
    ToolButton2.ImageIndex :=3;
    ToolButton4.ImageIndex :=5;
    ToolButton5.ImageIndex :=7;
    ToolButton6.ImageIndex :=9;
    ToolButton9.ImageIndex :=12;
  end;
  N9.Enabled :=not Logined;
  ToolButton1.Enabled :=not Logined;
  U1.Enabled :=Logined;
  N1.Enabled :=Logined;
  N2.Enabled :=Logined;
  B1.Enabled :=Logined;
  N10.Enabled :=Logined;
  N4.Enabled :=Logined;
  ToolButton2.Enabled :=Logined;
  ToolButton4.Enabled :=Logined;
  ToolButton5.Enabled :=Logined;
  ToolButton6.Enabled :=Logined;
  ToolButton9.Enabled :=Logined;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  UserList:=TStringList.Create;

  StatusBar1.Panels[0].Text :='状态:未登录';
  N1.Enabled :=false;
  N1.ImageIndex :=5;
  N2.Enabled :=false;
  N2.ImageIndex :=7;
  B1.Enabled :=false;
  B1.ImageIndex :=9;
  N10.Enabled :=false;
  N10.ImageIndex :=12;
  N4.Enabled :=false;
  N4.ImageIndex :=14;
  U1.Enabled :=false;
  U1.ImageIndex :=3;
  ToolButton2.Enabled :=false;
  ToolButton2.ImageIndex :=3;
  ToolButton4.Enabled :=false;
  ToolButton4.ImageIndex :=5;
  ToolButton5.Enabled :=false;
  ToolButton5.ImageIndex :=7;
  ToolButton6.Enabled :=false;
  ToolButton6.ImageIndex :=9;
  ToolButton9.Enabled :=false;
  ToolButton9.ImageIndex :=12;
end;

procedure TForm1.U1Click(Sender: TObject);
begin
  Logined:=false;
  UpDateState;
  N9.ImageIndex :=0;
  ToolButton1.ImageIndex :=0;
  N9.Enabled :=true;
  ToolButton1.Enabled :=true;
  Locked:=true;
end;

procedure TForm1.UMRestoreApplication(var Message: TMessage);
begin
  if IsIconic(application.Handle) then
    application.Restore
  else
    application.BringToFront ;   
end;

procedure TForm1.StrToList(Str: string; var List: TStrings;
  BreakSymbol: string);
var
  I: Integer;
begin
  for I := 1 to Length(Str) do
    if Str[I] = BreakSymbol then
      Str[I] := #13;
  List.Text := Str;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  if not assigned(addfrm) then
    addfrm:=Taddfrm.Create(self);
  addfrm.ShowModal;    
end;

function TForm1.StringsToStr(Str, BreakSymbol: string): string;
var
  S: TStrings;
  i: Integer;
begin
  Result := '';
  S := TStringList.Create;
  try
    S.Text := Str;
    for i := 0 to S.Count - 1 do
      if i<S.Count then
        Result := Result + Trim(S[i]) + BreakSymbol
      else
        Result := Result + Trim(S[i]);
  finally
    S.Free;
  end;
end;

procedure TForm1.WMQueryEndSession(var Msg: TMessage);
begin
  //CloseTheInstance;
  inherited;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CloseTheInstance;
end;

procedure TForm1.CloseTheInstance;
var
  i:integer;
begin
  if chat.Con.Connected then
  begin
    if chat.RealTemp.Active then
      chat.RealTemp.Close;
    chat.RealTemp.SQL.Clear;     
    chat.RealTemp.SQL.Text:='select Handle from UserInfo'+#13+
                            'where Logined=1';
    chat.RealTemp.Open;
    if not chat.RealTemp.IsEmpty then
    begin
      while not chat.RealTemp.Eof do
      begin
        i:=GetIndexByHandle(chat.RealTemp.Fields[0].AsInteger);
        SendBy(s.Socket.Connections[i],'admin','1','Admin'+'('+datetimetoStr(Now)+'):'+#13#10+'  服务器将在一分种后关闭...' ,
          '','','','','');
        chat.RealTemp.Next;
      end;
    end;
    chat.RealTemp.Close;  
    //sleep(60000);
    chat.Con.Connected :=false;
  end;

  if assigned(UserList) then
    UserList.Free;
end;


procedure TForm1.ReturnGameCommand(MyHandle, UserHandle, CommandStr, Param1,
  Param2,Param4,Param5: string);
var
  i:integer;
  FFlag,FNowStyle:integer;
  LinesStyle:integer;
begin
  randomize;
  Fflag:=random(7);
  FNowStyle:=1;
  case Fflag of
    0: FNowStyle:=1;
    1,2,6: FNowStyle:=random(2)+1;
    3,4,5: FNowStyle:=random(4)+1;
  end;

  LinesStyle:=random(16384);//2的14次方，因为俄罗斯的宽度为14
  if LinesStyle=0 then
    inc(LinesStyle)
  else if LinesStyle=16383 then
    dec(LinesStyle);

  i:=GetIndexByHandle(strtoint(UserHandle));//用户的句柄
  SendBy(s.Socket.Connections[i],'P',UserHandle,Param1+'.'+inttostr(Fflag),Param2+'.'+inttostr(FNowStyle),'Secd',inttostr(Fflag)+'.'+inttostr(FNowStyle)+';'+inttostr(LinesStyle),Param5,CommandStr);

  i:=GetIndexByHandle(strtoint(MyHandle));//自己的句柄
  SendBy(s.Socket.Connections[i],'P',MyHandle,Param1+'.'+inttostr(Fflag),Param2+'.'+inttostr(FNowStyle),'Prim',inttostr(Fflag)+'.'+inttostr(FNowStyle)+';'+inttostr(LinesStyle),Param4,CommandStr);
end;

function TForm1.NewID(Handle:integer=0): string;
var
  x:TTimeStamp;
begin
  x:=DateTimetoTimeStamp(now);
  result:=inttostr(lo(x.Date))+inttostr(hi(x.Time))+inttostr(Handle);
end;

procedure TForm1.B1Click(Sender: TObject);
begin
  if not assigned(frmBrowseUser) then
    frmBrowseUser:=TfrmBrowseUser.Create(nil);
  BrowseUser;
  frmBrowseUser.Show;
end;

procedure TForm1.BrowseUser;
var
  UserItem:TListItem;
begin
  if not assigned(frmBrowseUser) then exit;

  frmBrowseUser.UserList.Clear;  

  Chat.qryUser.Close;
  Chat.qryUser.Parameters.ParamByName('ID').Value:=0;
  Chat.qryUser.Parameters.ParamByName('PasswordA').Value:='a';
  Chat.qryUser.Parameters.ParamByName('a').Value:=0;
  Chat.qryUser.Parameters.ParamByName('b').Value:=0;
  Chat.qryUser.Parameters.ParamByName('c').Value:=0;
  Chat.qryUser.Open;

  while not Chat.qryUser.Eof do
  begin
    UserItem:=frmBrowseUser.UserList.Items.Add;
    UserItem.Caption:=Chat.qryUser.FieldValues['UserName'] ;
    UserItem.ImageIndex:=Chat.qryUser.FieldValues['Sex']*2+Chat.qryUser.FieldValues['Logined']+17+2*Chat.qryUser.FieldValues['Deleted']*(2-Chat.qryUser.FieldValues['Sex']);
    UserItem.SubItems.Add(Chat.qryUser.FieldValues['ID']);
    UserItem.SubItems.Add(Chat.qryUser.FieldValues['Host']);
    UserItem.SubItems.Add(Chat.qryUser.FieldValues['Address']);
    UserItem.SubItems.Add(Chat.qryUser.FieldValues['Deleted']);
    UserItem.SubItems.Add(Chat.qryUser.FieldValues['Handle']);
    UserItem.SubItems.Add(Chat.qryUser.FieldValues['Logined']);
    UserItem.SubItems.Add(Chat.qryUser.FieldValues['Sex']);
    Chat.qryUser.Next;
  end;

  frmBrowseUser.Label1.Caption:=' 共'+inttostr(frmBrowseUser.UserList.Items.Count)+'位：';
end;

procedure TForm1.G1Click(Sender: TObject);
begin
  frmConfig:=TfrmConfig.Create(nil);
  frmConfig.ShowModal;
  freeandnil(frmConfig);
end;

procedure TForm1.GetUserList1(Handle: integer; ID, SearchID, SearchName: string);
var
  HandleStr:string;
  UserNameStr:string;
  LoginedStr:string;
  SexStr:string;
  IDStr:string;
  i:integer;
begin
  i:=GetIndexByHandle(Handle);
  chat.RealTemp.Close;
  chat.RealTemp.SQL.Clear;
  chat.RealTemp.SQL.Add('select u.Handle,u.UserName,u.Host,u.Address,u.Sex,u.Logined,u.ID');
  chat.RealTemp.SQL.Add('from UserInfo u');
  chat.RealTemp.SQL.Add('where u.ID<>'''+ID+'''');
  if SearchID<>'?' then
    chat.RealTemp.SQL.Add('and u.ID='''+SearchID+'''');
  if SearchName<>'?' then
    chat.RealTemp.SQL.Add('and u.UserName='''+SearchName+'''');
  chat.RealTemp.SQL.Add('and u.ID not in (select g.SubID from Groups g where g.ID='''+ID+''')');
  chat.RealTemp.SQL.Add('order by u.Logined Desc');
  chat.RealTemp.Open ;

  if not chat.RealTemp.IsEmpty then
  begin
    while not chat.RealTemp.Eof do
    begin
      HandleStr:=HandleStr+inttostr(chat.RealTemp.FieldValues['Handle'])+#13;
      UserNameStr:=UserNameStr+chat.RealTemp.FieldValues['UserName']+#13;
      LoginedStr:=LoginedStr+inttostr(byte(chat.RealTemp.FieldValues['Logined']))+#13;
      SexStr:=SexStr+inttostr(byte(chat.RealTemp.FieldValues['Sex']))+#13;
      IDStr:=IDStr+chat.RealTemp.FieldValues['ID']+#13;
      chat.RealTemp.next;
    end;
  end;

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

end.