client_mainform.pas

Delphi快速开发Web Server

    begin
    node:=tvFriends.Items.Item[i];
    if LowerCase(node.Text)=uname then
      begin
      Result:=True;
      Break;
      end;
    end;
  end;

function TForm1.isIgnore(uname: string): boolean;
  var
    i:integer;
    node:TTreeNode;
  begin
  uname:=LowerCase(uname);
  Result:=False;
  for i:=0 to tvIgnore.Items.Count-1 do
    begin
    node:=tvIgnore.Items.Item[i];
    if LowerCase(node.Text)=uname then
      begin
      Result:=True;
      Break;
      end;
    end;
  end;

procedure TForm1.FriendList_Status(uname:string; status:integer);
  var
    i:integer;
    node:TTreeNode;
  begin
  uname:=LowerCase(uname);
  for i:=0 to tvFriends.Items.Count-1 do
    begin
    node:=tvFriends.Items.Item[i];
    if LowerCase(node.Text)=uname then
      begin
      node.ImageIndex:=status;
      node.SelectedIndex:=status;
      node.StateIndex:=status;
      Break;
      end;
    end;
  tvFriends.Update;
  end;

function TForm1.FriendList_Selected: string;
  begin
  if tvFriends.Selected<>nil then
    Result:=tvFriends.Selected.Text
  else
    Result:='';
  end;

function TForm1.IgnoreList_Selected: string;
  begin
  if tvIgnore.Selected<>nil then
    Result:=tvIgnore.Selected.Text
  else
    Result:='';
  end;

procedure TForm1.btnAddFriendClick(Sender: TObject);
  var
    s:string;
  begin
  s:='';
  if InputQuery('Add Friend','Please enter your Friend''s username:',s) then
    if s<>'' then
      if (UpperCase(s)=UpperCase(myUserName)) then
        ShowMessage('You can not add yourself to friends list.')
      else if isFriend(s) then
        ShowMessage(s+' is already on your Friends list.')
      else
        begin
        with ClientModule, Data.NewFunction('AddFriend') do
          begin
          Value['User']:=myUserName;
          Value['Name']:=s;
          Call(resUpdate);
          end;
        FriendList_Add(s);
        end;
  end;

procedure TForm1.btnAddIgnoreClick(Sender: TObject);
  var
    s:string;
  begin
  s:='';
  if InputQuery('Add User to Ignore','Please enter the name of the user:',s) then
    if s<>'' then
      if (UpperCase(s)=UpperCase(myUserName)) then
        ShowMessage('You can not add yourself to ignore list.')
      else if isIgnore(s) then
        ShowMessage(s+' is already on your Ignore list.')
      else
        begin
        with ClientModule, Data.NewFunction('AddIgnore') do
          begin
          Value['User']:=myUserName;
          Value['Name']:=s;
          Call(resUpdate);
          end;
        IgnoreList_Add(s);
        end;
  end;

procedure TForm1.btnDelFriendClick(Sender: TObject);
  var
    fname:string;
  begin
  fname:=FriendList_Selected;
  if fname='' then Exit;

  if MessageDlg('Delete "'+fname+'" from your Friends list?',
                mtWarning,[mbYes,mbNo],0)=mrYes then
    begin
    with ClientModule, Data.NewFunction('DelFriend') do
      begin
      Value['User']:=myUserName;
      Value['Name']:=fname;
      Call(resUpdate);
      end;
    FriendList_Del(fname);
    end;
  end;

procedure TForm1.btnDelIgnoreClick(Sender: TObject);
  var
    fname:string;
  begin
  fname:=IgnoreList_Selected;
  if fname='' then Exit;

  if MessageDlg('Delete "'+fname+'" from your IGNORE list?',
                mtWarning,[mbYes,mbNo],0)=mrYes then
    begin
    with ClientModule, Data.NewFunction('DelIgnore') do
      begin
      Value['User']:=myUserName;
      Value['Name']:=fname;
      Call(resUpdate);
      end;
    IgnoreList_Del(fname);
    end;
  end;

procedure TForm1.btnSendMessageClick(Sender: TObject);
  var
    s:string;
  begin
  s:=FriendList_Selected;
  if isIgnore(s) then
    ShowMessage('This user is on your IGNORE list.'#13#10+
                'You can not send messages to users on your IGNORE list.')
  else if isFriend(s) then
    TChatForm.getForm(s).BringToFront
  else
    MessageBeep(0);
  end;

procedure TForm1.SendText(to_user, msg: string);
  var
    chat:TChatForm;
  begin
  chat:=TChatForm.getForm(to_user);
  chat.AddMessage(myUserName, msg, RTC_ADDMSG_SELF);

  with ClientModule, Data.NewFunction('SendText') do
    begin
    Value['user']:=myUserName;
    Value['to']:=to_user;
    asText['text']:=msg;
    Call(resSendText);
    end;
  end;

procedure TForm1.msgTimerTimer(Sender: TObject);
  begin
  with TimerModule, Data.NewFunction('GetData') do
    begin
    Value['user']:=myUserName;
    Value['check']:=myCheckTime;
    Call(resTimer);
    end;
  end;

procedure TForm1.resTimerReturn(Sender: TRtcConnection; Data,Result: TRtcValue);
  var
    chat:TChatForm;
    i:integer;
    fname:string;
  begin
  if Result.isType=rtc_Exception then
    begin
    if myUserName<>'' then
      begin
      btnLogoutClick(nil);
      MessageBeep(0);
      ShowMessage(Result.asString);
      end;
    end
  else if not Result.isNull then // data arrived
    begin
    if Sender<>nil then
      begin
      with Result.asRecord do
        myCheckTime:=asDateTime['check'];
      // Check for new messages
      msgTimerTimer(nil);
      // User interaction is needed, need to Post the event for user interaction
      PostInteractive;
      end;

    with Result.asRecord do
      begin
      if isType['data']=rtc_Array then with asArray['data'] do
        for i:=0 to Count-1 do
          if isType[i]=rtc_Record then with asRecord[i] do
            if not isNull['text'] then // Text message
              begin
              fname:=asString['from'];
              if not isIgnore(fname) then
                begin
                if isFriend(fname) then
                  begin
                  chat:=TChatForm.getForm(fname,do_notify);
                  chat.AddMessage(fname, asText['text'], RTC_ADDMSG_FRIEND);
                  end
                else
                  begin
                  MessageBeep(0);
                  if MessageDlg('User "'+fname+'" has sent you a message,'#13#10+
                                   'but he/she is not on your Friends list.'#13#10+
                                   'Accept the message and add "'+fname+'" to your Friends list?',
                              mtConfirmation,[mbYes,mbNo],0)=mrYes then
                    begin
                    chat:=TChatForm.getForm(fname,do_notify);
                    chat.AddMessage(fname, asText['text'], RTC_ADDMSG_FRIEND);
                    with ClientModule, Data.NewFunction('AddFriend') do
                      begin
                      Value['User']:=myUserName;
                      Value['Name']:=fname;
                      Call(resUpdate);
                      end;
                    FriendList_Add(fname);
                    end
                  else if MessageDlg('Add "'+fname+'" to your IGNORE list?',
                                     mtWarning,[mbYes,mbNo],0)=mrYes then
                    begin
                    with ClientModule, Data.NewFunction('AddIgnore') do
                      begin
                      Value['User']:=myUserName;
                      Value['Name']:=fname;
                      Call(resUpdate);
                      end;
                    IgnoreList_Add(fname);
                    end;
                  end;
                end;
              end
            else if not isNull['login'] then // Friend logging in
              begin
              fname:=asString['login'];
              make_notify(fname, 'login');
              if isFriend(fname) then
                FriendList_Status(fname,MSG_STATUS_ONLINE);
              end
            else if not isNull['logout'] then // Friend logging out
              begin
              fname:=asString['logout'];
              make_notify(fname, 'logout');
              if isFriend(fname) then
                FriendList_Status(fname,MSG_STATUS_OFFLINE);
              end
            else if not isNull['addfriend'] then // Added as Friend
              begin
              fname:=asString['addfriend'];
              if not isIgnore(fname) then
                begin
                MessageBeep(0);
                if isFriend(fname) then
                  ShowMessage('User "'+fname+'" added you as a Friend.')
                else
                  begin
                  MessageBeep(0);
                  if MessageDlg('User "'+fname+'" added you as a Friend.'#13#10+
                              'Add "'+fname+'" to your Friends list?',
                              mtConfirmation,[mbYes,mbNo],0)=mrYes then
                    begin
                    with ClientModule, Data.NewFunction('AddFriend') do
                      begin
                      Value['User']:=myUserName;
                      Value['Name']:=fname;
                      Call(resUpdate);
                      end;
                    FriendList_Add(fname);
                    end
                  else if MessageDlg('Add "'+fname+'" to your IGNORE list?',
                                     mtWarning,[mbYes,mbNo],0)=mrYes then
                    begin
                    with ClientModule, Data.NewFunction('AddIgnore') do
                      begin
                      Value['User']:=myUserName;
                      Value['Name']:=fname;
                      Call(resUpdate);
                      end;
                    IgnoreList_Add(fname);
                    end;
                  end;
                end;
              end
            else if not isNull['addignore'] then // Added as Ignore
              begin
              fname:=asString['addignore'];
              if not isIgnore(fname) then
                begin
                MessageBeep(0);
                if MessageDlg('User "'+fname+'" has chosen to IGNORE you.'#13#10+
                              'Add "'+fname+'" to your IGNORE list?',
                              mtWarning,[mbYes,mbNo],0)=mrYes then
                  begin
                  with ClientModule, Data.NewFunction('AddIgnore') do
                    begin
                    Value['User']:=myUserName;
                    Value['Name']:=fname;
                    Call(resUpdate);
                    end;
                  IgnoreList_Add(fname);
                  end;
                end;
              end
            else if not isNull['delfriend'] then // Removed as Friend
              begin
              fname:=asString['delfriend'];
              if isFriend(fname) and not isIgnore(fname) then
                begin
                MessageBeep(0);
                if MessageDlg('User "'+fname+'" removed you as a Friend.'#13#10+
                              'Remove "'+fname+'" from your Friends list?',
                              mtConfirmation,[mbYes,mbNo],0)=mrYes then
                  begin
                  with ClientModule, Data.NewFunction('DelFriend') do
                    begin
                    Value['User']:=myUserName;
                    Value['Name']:=fname;
                    Call(resUpdate);
                    end;
                  FriendList_Del(fname);
                  end;
                end;
              end
            else if not isNull['delignore'] then // Removed as Ignore
              begin
              fname:=asString['delignore'];
              if not isIgnore(fname) then
                begin
                MessageBeep(0);
                ShowMessage('User "'+fname+'" has removed you from his IGNORE list.');
                end;
              end;
      end;
    do_notify:=True;
    end
  else
    begin
    if Sender<>nil then
      begin
      // Check for new messages
      myCheckTime:=0;
      msgTimerTimer(nil);
      // We don't want to set do_notify to TRUE if user interaction is in progress
      PostInteractive;
      end;
    do_notify:=True;
    end;
  end;

procedure TForm1.resSendTextReturn(Sender: TRtcConnection; Data, Result: TRtcValue);
  var
    chat:TChatForm;
  begin
  if Result.isType=rtc_Exception then
    begin
    chat:=TChatForm.getForm(Data.asFunction.asString['to'],do_notify);
    chat.AddMessage('ERROR!', Result.asString+#13#10+'Message not delivered ...', RTC_ADDMSG_ERROR);
    chat.AddMessage(myUserName, Data.asFunction.asString['text'], RTC_ADDMSG_ERROR);
    end;
  end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  begin
  if myUserName<>'' then
    begin
    btnLogout.Click;

    // wait up to 2 second for any pending requests to complete
    Client.WaitForCompletion(False,2);

    CanClose:=True;
    end
  else
    CanClose:=True;
  end;

procedure TForm1.resLogoutReturn(Sender: TRtcConnection; Data, Result: TRtcValue);
  begin
  btnLogoutClick(nil);
  end;

procedure TForm1.resTimerLoginReturn(Sender: TRtcConnection; Data, Result: TRtcValue);
  begin
  if Result.isType=rtc_Exception then
    begin
    if myUserName<>'' then
      begin
      btnLogoutClick(nil);
      MessageBeep(0);
      ShowMessage(Result.asString);
      end;
    end;
  end;

procedure TForm1.make_notify(uname, ntype :string);
  var
    chat:TChatForm;
  begin
  if TChatForm.isFormOpen(uname) then
    begin
    chat:=TChatForm.getForm(uname, do_notify);
    if ntype='login' then
      chat.AddMessage(uname, '<LOGGED IN>', RTC_ADDMSG_LOGIN)
    else if ntype='logout' then
      chat.AddMessage(uname, '<LOGGED OUT>', RTC_ADDMSG_LOGOUT);
    end;
  end;

procedure TForm1.pingTimerTimer(Sender: TObject);
  begin
  pingTimer.Enabled:=False;
  with ClientModule, Data.NewFunction('Ping') do
    Call(resPing);
  end;

procedure TForm1.resPingReturn(Sender: TRtcConnection; Data, Result: TRtcValue);
  begin
  if Result.isType=rtc_Exception then
    begin
    btnLogoutClick(nil);
    MessageBeep(0);
    ShowMessage(Result.asString);
    end
  else
    pingTimer.Enabled:=True;
  end;

end.