Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, xmldom, XMLIntf, msxmldom,
  XMLDoc, Sockets, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient,IdException, sha1, oxmldom, xercesxmldom,
  uMessageQueue, uTakeOutThread,uWorkThread, uWorkXML ,uRosterItems,uAuthorize,
  ComCtrls, ImgList,uShowMessage, Menus, ToolWin,global_const, ExtCtrls, uAddInRoster,
  RXShell

 { ShellAPI,
  janXMLparser2, ComCtrls, StdCtrls, ExtCtrls, ToolWin, Menus,
  inifiles, janStrings, janMruMenu, SynEditHighlighter, SynHighlighterHtml,
  SynEdit, Db, BaseDataset, janXMLDataSet2, Grids, DBGrids, DBCtrls,
  ImgList};

type
  TfMain = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    XMLDocument1: TXMLDocument;
    Memo1: TMemo;
    IdTCPClient1: TIdTCPClient;
    Memo2: TMemo;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    lvRoster: TListView;
    ImageList1: TImageList;
    pumStatus: TPopupMenu;
    Online1: TMenuItem;
    ReadytoChat1: TMenuItem;
    N1: TMenuItem;
    Away1: TMenuItem;
    Not1: TMenuItem;
    Donotdisturb1: TMenuItem;
    Invisible1: TMenuItem;
    Offline1: TMenuItem;
    Panel1: TPanel;
    BitBtn3: TBitBtn;
    N2: TMenuItem;
    N3: TMenuItem;
    BitBtn4: TBitBtn;
    pumMain: TPopupMenu;
    AddRosterItem: TMenuItem;
    N4: TMenuItem;
    Quit1: TMenuItem;
    pumRosterItem: TPopupMenu;
    SendMessage1: TMenuItem;
    N5: TMenuItem;
    Rename1: TMenuItem;
    Remove1: TMenuItem;
    Authorization1: TMenuItem;
    Resendauthorizationto1: TMenuItem;
    Rerequestauthorizationfrom1: TMenuItem;
    Removeauthorizationfrom1: TMenuItem;
    RxTrayIcon1: TRxTrayIcon;
    PopupMenuTray: TPopupMenu;
    ShowJabber1: TMenuItem;
    CloseJabber1: TMenuItem;

    procedure BitBtn1Click(Sender: TObject);

    procedure AppMinimize(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure lvRosterDblClick(Sender: TObject);
    procedure pumStatusPopup(Sender: TObject);
    procedure Offline1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure AddRosterItemClick(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure lvRosterKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Quit1Click(Sender: TObject);
    procedure lvRosterMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SendMessage1Click(Sender: TObject);
    procedure Remove1Click(Sender: TObject);
    procedure Resendauthorizationto1Click(Sender: TObject);
    procedure Rerequestauthorizationfrom1Click(Sender: TObject);
    procedure Removeauthorizationfrom1Click(Sender: TObject);
    procedure Rename1Click(Sender: TObject);
    procedure lvRosterEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShowJabber1Click(Sender: TObject);
    procedure CloseJabber1Click(Sender: TObject);

  protected
    procedure WMGetSysCommand(var message : TMessage); message WM_SYSCOMMAND;
  private
    ToSendQueue, ToReceiveQueue  : TMessageQueue;
    SendThread, ReceiveThread : TWorkThread;
    TakeOutThread : TTakeOutThread;
    Server, Login, Pass, FullJid, Resource : string;
    UserList : TStringList;
    OpenMessageWindows : TStringList;
    auth_first, must_close: boolean;
    procedure ChangeRoster;
    procedure OpenMessageWindow(puser : PUserItem; input_msg:string='');
    procedure QuitJabber;
  public
    { Public declarations }
     procedure GetMessageFromServer(packet:string);
  //   function Authorize : boolean;
     function GetRoster : boolean;
     function ChengeUserPresence(PresenceStock: IXMLNode): boolean;
     procedure ReceiveMessage(ReceiveStock: IXMLNode);
     procedure ReceiveIQ(IQStock: IXMLNode);
       function ReceiveIQ_Set_Roster(IQ_QueryStock: IXMLNode): boolean;
     procedure SendMessage(to_user : string; msg : string);
     procedure CloseMessageWindow(to_user : string);
     procedure SendStatus(ind:integer);
     function DelFromRoster(puser : PUserItem): boolean;
     procedure LoadLocalProperty;
     procedure SaveLocalProperty;
     procedure MyDisconnect;
     procedure ClearUserList;

  end;

var
  fMain: TfMain;
  first : boolean;
//  XMLParser: TjanXMLParser2;
implementation

uses uRename;

{$R *.dfm}

// Îáðàáîòêà ñîîáùåíèÿ WM_SYSCOMMAND
procedure TfMain.WMGetSysCommand(var message : TMessage) ;
begin
  if (message.wParam = SC_CLOSE) then // SC_MINIMIZE
  begin
    //ShowWindow(Application.Handle, SW_SHOW);
    ShowWindow(Handle, SW_HIDE);
  end
  else
    inherited;
end;

procedure TfMain.BitBtn1Click(Sender: TObject);
var res : boolean;
begin

  fMain.Hide;
  //÷èòàòü íàñòðîéêè èç ôàéëà
  Server :=  'xmpp.org.ru' ;
  Login :=  'testuser' ;
  Pass :=  'testuserlena' ;
 // fAuthorize.InitForm(IdTCPClient1,Server,Login,Pass);
  if fAuthorize.TryAuthorize then
    begin
      //  FullJid :=   Login+'@'+ Server+'/'+'TFE';
        TakeOutThread.Resume;
        SendThread.Resume;
        ReceiveThread.Resume;

        BitBtn2.Enabled := true;

      fMain.Show;
    end;
  
  //**** tcp ***
  (* Server :=  edServer.Text ;
   Login :=  edJID.Text ;
   Pass :=  edPass.Text ;
   IdTCPClient1.Host :=  Server;//'xmpp.org.ru';   //   '192.168.1.150'; //
   IdTCPClient1.Port := 5222;

  try
    IdTCPClient1.Connect();
    if Authorize then
      begin
        TakeOutThread.Resume;
        SendThread.Resume;
        ReceiveThread.Resume;

        BitBtn2.Enabled := true;
        Form2.Show;
       // Form1.Hide;
      end
  except
    ShowMessage('#@$%%((!@#$!!!!');
    exit;
  end;  *)
end;

procedure TfMain.AppMinimize(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TfMain.BitBtn2Click(Sender: TObject);
var str, str2: string;
    stim : TMemoryStream;
    i: integer;
    errormsg:string;
begin
   {  ipsXMPPS1.MessageText:='Hello!!! May be OK%)';
     ipsXMPPS1.MessageThread:= 'chat';
     ipsXMPPS1.MessageType:= mtNormal;

     ipsXMPPS1.SendMessage('dancer@xmpp.org.ru');  }
    //**** tcp ***
   //   str2 := '<?xml version='+''''+'1.0'+''''+'?><stream:stream xmlns='+''''+'jabber:client'+''''+' xmlns:stream='+''''+'http://etherx.jabber.org/streams'+''''+' id='+''''+'none'+''''+' from='+''''+'jabber.ttn.ru'+''''+' version='+''''+'1.0'+''''+'><stream:error><xml-not-wel-formed xmlns='+''''+'urn:ietf:params:xml:ns:xmpp-streams'+''''+'/></stream:error></stream:stream>';
   // ShowMessage(IntToStr(Length(str2)));
       str2 := '';
   //   str :=  '<?xml version='+''''+'1.0'+''''+' encoding='+''''+'UTF-8'+''''+' ?>'+#13#10+'<stream:stream to='+''''+'xmpp.org.ru'+''''+' xmlns='+''''+'jabber:client'+''''+' xmlns:stream='+''''+'http://etherx.jabber.org/streams'+''''+'>';
      str :=  memo2.Lines.Text;
     { XMLDocument1.LoadFromXML(str);
      for i :=0 to XMLDocument1.DocumentElement.ChildNodes.Count-1 do
        begin
          XMLDocument1.DocumentElement.ChildNodes[i]
        end;   }
      memo1.Lines.Append(str);


      //TcpClient1.SendBuf(str,Length(str));
     // IdTCPClient1.WriteStream(stim,false,true,stim.Size);
   //!!! IdTCPClient1.WriteBuffer(str[1],Length(str));
   ToSendQueue.Put(str);
    //IdTCPClient1.Socket.Send()
      memo1.Lines.Append('<----------------->');


 (*     try
   //   IdTCPClient1.ReadStream(stim,16384);
   //    SetLength(str2, 150 );        //  262
   //  IdTCPClient1.ReadBuffer(str2[1],143);
     str2 :=IdTCPClient1.CurrentReadBuffer;
   {  if not first then
     begin
     XMLDocument1.LoadFromXML(str2);
      for i :=0 to XMLDocument1.DocumentElement.ChildNodes.Count-1 do
        begin
          XMLDocument1.DocumentElement.ChildNodes[i]
        end;
     end
     else first := false;    }
      memo1.Lines.Append(str2);
      memo1.Lines.Append('<----------------->');
      except
         // DoTerminate;
        on  e:EIdConnClosedGracefully  do
          begin

            errormsg:= e.Message;
             ShowMessage(errormsg);
          end;
        on e:EIdSilentException do
            begin
             errormsg:= e.Message;
             ShowMessage(errormsg);
          end;
        on e:EIdNotConnected do
            begin
             errormsg:= e.Message;
               ShowMessage(errormsg);
          end;
         on e:EIdSocketError do
            begin
             errormsg:= e.Message;
               ShowMessage(errormsg);
          end
        else
              errormsg:= 'Left Error';
              ShowMessage(errormsg);
       end;
       *)
end;


procedure TfMain.FormCreate(Sender: TObject);
var str: string;
    i :integer;
begin
    must_close:= false;
    ToSendQueue := TMessageQueue.Create;
    ToReceiveQueue := TMessageQueue.Create;

    TakeOutThread := TTakeOutThread.Create(true);
 // TakeOutThread.
  SendThread := TWorkThread.Create(true);
  ReceiveThread := TWorkThread.Create(true);

  SendThread.InitThread(2,ToSendQueue,IdTCPClient1);
  ReceiveThread.InitThread(1,ToReceiveQueue,IdTCPClient1);
  TakeOutThread.InitThread(ToReceiveQueue);

 // ReceiveThread.OnTerminate:= WhenTerminatedThread;
  //TakeOutThread.OnTerminate:= WhenTerminatedThread;

 //   XMLParser := TjanXMLParser2.Create;
  UserList := TStringList.Create;
  OpenMessageWindows := TStringList.Create;
  fMain.Visible:= false;
  auth_first := true;
  for i := 0 to pumStatus.Items.Count-1 do
    pumStatus.Items[i].ImageIndex := pumStatus.Items[i].Tag;
  BitBtn3.Align := alLeft;
  BitBtn4.Align := alClient;
end;

procedure TfMain.Button2Click(Sender: TObject);
var temp : string;
begin
///
temp := ProgrammDirectory;
if SaveDialog1.Execute then
 begin
  memo1.Lines.SaveToFile(SaveDialog1.FileName);
 end; 
ProgrammDirectory := temp;
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
     TakeOutThread.Resume;
      SendThread.Resume;
      ReceiveThread.Resume;

      TakeOutThread.StopWork;
      ReceiveThread.StopWork;
      SendThread.StopWork;
   sleep(500);


 // IdTCPClient.Disconnect;
  TakeOutThread.Free;
  SendThread.Free;
  ReceiveThread.Free;


  ToReceiveQueue.Free;

  ToSendQueue.Free;


end;

procedure TfMain.GetMessageFromServer(packet:string);
var     MainStock: IXMLNode;
        nodename, error : string;
        i : integer;

begin
   memo1.Lines.Append(packet);
   memo1.Lines.Append('<----------------->');
   if not IsNotError(packet,error) then
      begin
        if IsDisconnectStream(packet) then // îòêëþ÷åíèå èç-çà îøèáêè
          begin
            IdTCPClient1.Disconnect;
            ShowMessage('Disconnect!');
            MyDisconnect;
          end;
        exit;
      end;
    //íîðìàëüíîå îòêëþ÷åíèå
    if IsDisconnectStream(packet) then
          begin
            IdTCPClient1.Disconnect;
            MyDisconnect;
            if must_close then Close;
            exit;
          end;
   //êîñòûëü!
   packet := '<mainstr> '+packet+' </mainstr>';
   XMLDocument1.LoadFromXML(packet);

  for i:= 0 to XMLDocument1.DocumentElement.ChildNodes.Count-1 do
    begin
      MainStock := XMLDocument1.DocumentElement.ChildNodes[i];
      nodename := LowerCase(trim(MainStock.NodeName));
      if nodename ='presence'  then
        begin
            if ChengeUserPresence(MainStock)then
            ChangeRoster;
        end
      else
      if nodename ='message'  then
        begin
          ReceiveMessage(MainStock);
        //îïðåäåëèòü îò êîãî, è òî÷íî ëè ìíå
        //îòêðûòü îêíî èëè ïîêàçàòü åãî
        //äîáàâèòü òóäà ñîîáùåíèå
        end
      else
        if nodename ='iq'  then
        begin
          ReceiveIQ(MainStock);
        end
      else ShowMessage(MainStock.NodeName)
    end;
end;
procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 IdTCPClient1.Disconnect;
end;

{function TfMain.Authorize : boolean;
var str1, str2 , error, id_attr,attr,iq_id, hash: string;

begin
    result := false;
    str1 := '<?xml version='+''''+'1.0'+''''+' encoding='+''''+'UTF-8'+''''+' ?><stream:stream to='+''''+Server+''''+' xmlns='+''''+'jabber:client'+''''+' xmlns:stream='+''''+'http://etherx.jabber.org/streams'+''''+'>';
    IdTCPClient1.WriteBuffer(str1[1],Length(str1));
    str2 := '';
    str2 := IdTCPClient1.CurrentReadBuffer;
    //ïðîñìîòðåòü íà íàëè÷èå îøèáîê, åñëè âñå âåðíî, òî âûöåïèòü èä
    if not IsNotError(str2,error) then
      begin
        ShowMessage(Error);
        exit;
      end;
    //îøèáêè íåò, èçâëå÷ü ID
    if not GetAttributeValue('id',str2,id_attr)then
      begin
        ShowMessage(str2);
        exit;
      end;
      iq_id :='auth_'+IntToStr(Random(1000));
      str1 :=  '<iq type='+''''+'get'+''''+' id='+''''+iq_id+''''+'><query xmlns='+''''+'jabber:iq:auth'+''''+'><username>'+Login+'</username></query></iq>';
      IdTCPClient1.WriteBuffer(str1[1],Length(str1));
      str2 := '';
      str2 := IdTCPClient1.CurrentReadBuffer;
     //ïîòîì íàäî íàâåðíî ñäåëàòü ðàçáîð, íî ïîêà õâàòèò ðîâåðêè íà îøèáêè
      if not IsNotError(str2,error) then
      begin
        ShowMessage(Error);
        exit;
      end;
      //ïðîâåðêà àòðèáóòà type íà ðàâåíñòâî result
     if not GetAttributeValue('type',str2,attr)then
      begin
        ShowMessage(str2);
        exit;
      end;
      if  (LowerCase(attr)<>'result') then
       begin
        ShowMessage(attr);
        exit;
      end;
       //ïðîâåðêà àòðèáóòà id íà ðàâåíñòâî ïîñëàííîìó èäó
     if not GetAttributeValue('id',str2,attr)then
      begin
        ShowMessage(str2);
        exit;
      end;
      if  (LowerCase(attr)<>iq_id) then
       begin
        ShowMessage(attr);
        exit;
      end;
     //îòñûëàåì èíôó äëÿ àâòîðèçàöèè
    iq_id :='auth_'+IntToStr(Random(1000));
    hash:= HashSha1(id_attr+Pass);
    str1 :=' <iq type='+''''+'set'+''''+' id='+''''+iq_id+''''+'><query xmlns='+''''+'jabber:iq:auth'+''''+'><username>'+Login+'</username>';
	  str1 := str1 + '<resource>TFI</resource><digest>'+hash+'</digest></query></iq>';
    IdTCPClient1.WriteBuffer(str1[1],Length(str1));
    str2 := '';
    str2 := IdTCPClient1.CurrentReadBuffer;
    //ðåçóëüòàò àâòîðèçàöèè, ïîïòîì ñäåëàòü ðàçáîð îøèáîê

      //ïðîâåðêà àòðèáóòà type íà ðàâåíñòâî result
     if not GetAttributeValue('type',str2,attr)then
      begin
        ShowMessage(str2);
        exit;
      end;
      if  (LowerCase(attr)<>'result') then
       begin
        ShowMessage(attr);
        exit;
      end;
       //ïðîâåðêà àòðèáóòà id íà ðàâåíñòâî ïîñëàííîìó èäó
     if not GetAttributeValue('id',str2,attr)then
      begin
        ShowMessage(str2);
        exit;
      end;
      if  (LowerCase(attr)<>iq_id) then
       begin
        ShowMessage(attr);
        exit;
      end;

      if not IsNotError(str2,error) then
      begin
        ShowMessage(Error);
        exit;
      end;

      result := true;
end;
}
procedure TfMain.LoadLocalProperty;
var
  f: TextFile;
  str: String;
  Name,Value:String;
  p: Integer;
begin
  AssignFile(f,ProgrammDirectory+'LocalSettings.cfg');
 try
  Reset(f);
  while not EOF(f) do
  begin
    ReadLn(f,str);
    Trim(str);
    P:= pos('=',str);
    if (p > 0) then
    begin
      Name:=copy(str,1,p-1);
      Name:=AnsiLowerCase(Name);
      Value:=copy(str,p+1,Length(str)-p);
      //Value:=AnsiLowerCase(Value);

    if (Name = 'login') then Login:=Value
      else if (Name = 'password') then Pass:=Value
      else if (Name = 'server') then Server:=Value

    end;
  end;
  CloseFile(f);
 except
 
 end;
end;

procedure TfMain.SaveLocalProperty;
var
  f: TextFile;
  str: String;
begin
  AssignFile(f,ProgrammDirectory+'LocalSettings.cfg');
  Rewrite(f);
  str:='server='+Trim(Server);
  Writeln(f,str);
  str:='login='+Trim(Login);
  Writeln(f,str);
  str:='password='+Trim(Pass);
  Writeln(f,str);
  CloseFile(f);
end;



procedure TfMain.FormActivate(Sender: TObject);
var str : string;
begin
 // Form1.Hide;
  //÷èòàòü íàñòðîéêè èç ôàéëà
  if not auth_first then   exit;
  auth_first:= false;

 { Server :=  'xmpp.org.ru' ;
  Login :=  'dancer' ;
  Pass :=  'gjnfywetv' ;}
  LoadLocalProperty;
  Resource := 'TFE';
  fAuthorize.InitForm(IdTCPClient1,PString(@Server),PString(@Login),PString(@Pass),PString(@Resource));
  if fAuthorize.TryAuthorize then
    begin
      SaveLocalProperty;
      //ïîëó÷èòü ðîñòåð
      fMain.Caption := Login+'@'+ Server;
      FullJid :=   Login+'@'+ Server+'/'+Resource;
      GetRoster;

        TakeOutThread.Resume;
        SendThread.Resume;
        ReceiveThread.Resume;

        BitBtn2.Enabled := true;
        ShowMessages.Init(Login,FullJid);
        fMain.Show;
        //ñìåíèòü ñòàòóñ íà â ñåòè

        SendStatus(STATUS_ON);
        //ïðÿ÷åì â tray
        Application.OnMinimize:=AppMinimize;
        Application.OnRestore:=AppMinimize;
        Application.Minimize;
        AppMinimize(@Self);
    end
  else   
end;


function TfMain.GetRoster : boolean;
var str1, str2 , error, id_attr,attr,iq_id, hash: string;
    i : integer;

    QueryStock: IXMLNode;
    puser : PUserItem;

begin
    result := false;
    ClearUserList;
      iq_id :='roster_'+IntToStr(Random(1000));
      str1 :=  '<iq type='+''''+'get'+''''+' id='+''''+iq_id+''''+'><query xmlns='+''''+'jabber:iq:roster'+''''+'></query></iq>';
      IdTCPClient1.WriteBuffer(str1[1],Length(str1));
      str2 := '';
      str2 := IdTCPClient1.CurrentReadBuffer;
      memo1.Lines.Append(str2);
      memo1.Lines.Append('<*********>');
     //ïîòîì íàäî íàâåðíî ñäåëàòü ðàçáîð, íî ïîêà õâàòèò ðîâåðêè íà îøèáêè
      if not IsNotError(str2,error) then
      begin
        ShowMessage(Error);
        exit;
      end;
      //ïðîâåðêà àòðèáóòà type íà ðàâåíñòâî result
     if not GetAttributeValue('type',str2,attr)then
      begin
        ShowMessage(str2);
        exit;
      end;
      if  (LowerCase(attr)<>'result') then
       begin
        ShowMessage(attr);
        exit;
      end;
       //ïðîâåðêà àòðèáóòà id íà ðàâåíñòâî ïîñëàííîìó èäó
     if not GetAttributeValue('id',str2,attr)then
      begin
        ShowMessage(str2);
        exit;
      end;
      if  (LowerCase(attr)<>iq_id) then
       begin
        ShowMessage(attr);
        exit;
      end;
     //ðàçáèðàåì þçåðîâ
     XMLDocument1.LoadFromXML(str2);
     QueryStock := XMLDocument1.DocumentElement.ChildNodes[0];
    // ShowMessage(QueryStock.NodeName);
      for i :=0 to QueryStock.ChildNodes.Count-1 do
        begin
          attr := trim(QueryStock.ChildNodes[i].Attributes['jid']);
          puser := new(PUserItem);
          if GetUserItemFromStr(attr,puser) then
            begin
              if (QueryStock.ChildNodes[i].Attributes['name']= null) then   puser.name_in_roster := puser.nick
              else  puser.name_in_roster := QueryStock.ChildNodes[i].Attributes['name'];
              if (QueryStock.ChildNodes[i].Attributes['subscription']=null)then QueryStock.ChildNodes[i].Attributes['subscription']:='both'
              else
                 puser.subscription := QueryStock.ChildNodes[i].Attributes['subscription'];
              if( puser.subscription = 'both') then puser.status := STATUS_OFF
              else puser.status := STATUS_SUBSCRIBE_NOT_BOTH;
              UserList.AddObject(attr,TObject(puser));
            end;
        end;
      ChangeRoster;
      result := true;
end;

function TfMain.ChengeUserPresence(PresenceStock: IXMLNode): boolean;
var user, subnode, resource,str : string;
    puser : PUserItem;
    ind, i : integer;
    was_show : boolean;
begin
  result := false;
//  type='unavailable'/>
  puser := new(PUserItem);
  user := PresenceStock.Attributes['from'];
  if GetUserItemFromStr(user,puser) then
    begin
    resource := puser.resource;
    ind := UserList.IndexOf(puser.jid);
    if (ind >= 0) then
      begin
      //êîíòàêò åñòü â ñïèñêå
        puser := PUserItem(UserList.Objects[ind]);
        puser.resource :=  resource;
       if (PresenceStock.Attributes['type']=null) then
         begin
            was_show := false;
            for i :=0 to PresenceStock.ChildNodes.Count-1 do
              begin
                subnode := lowerCase(trim(PresenceStock.ChildNodes[i].NodeName));
                if (subnode = 'show')then
                 
                  if PresenceStock.ChildNodes[i].IsTextElement then
                    begin
                      was_show := true;
                      if COMMAND_STATUS[puser.status] <> PresenceStock.ChildNodes[i].Text then
                        begin

                          ind := IndexByName(PresenceStock.ChildNodes[i].Text);
                          if (ind >= 0) then puser.status :=ind;
                          result := true;
                        end;
                    end;
              end;
            if not was_show then
              if puser.status <> STATUS_ON then
                begin
                  puser.status := STATUS_ON;
                  result := true;
                end;
          end
        ////þçåð â îôëàéíå èëè îòìåíèë àâòîðèçàöèþ è ò.ï.
        else if  (PresenceStock.Attributes['type']='unavailable')then
          begin
            if puser.status <> STATUS_OFF then
              begin
                puser.status := STATUS_OFF ;
                result := true;
              end;
          end
       ////ïðèøåë çàïðîñ íà àâòîðèçàöèþ
       else if  (PresenceStock.Attributes['type']='subscribe')then
         begin
           //ïîêàçàòü îêíî äëÿ ïîäòâåðæäåíèÿ/îòêëîíåíèÿ àâòîðèçàöèè
           case MessageDlg('Çàïðîñ àâòîðèçàöèè îò '+user, mtInformation, mbYesNoCancel	, 0) of
            mrYes:     //ïîäòâåðæäàþ+ äîáàâëÿþ åñëè íåò
              begin
                str := '<presence to='+''''+puser.jid+''''+'  type='+''''+'subscribed'+''''+'/>';
                TOSendQueue.Put(str);
                //åñëè ó ìåíÿ íå ò ïðèïèñêè, òî çàïðîñèòü
                 if (puser.subscription = 'from')or(puser.subscription = 'none')then
                  begin
                     str := '<presence to='+''''+puser.jid+''''+'  type='+''''+'subscribe'+''''+'/>';
                     TOSendQueue.Put(str);
                  end;

              end;
            mrNo:     //çàïðåùàþ
              begin
                str := '<presence to='+''''+puser.jid+''''+'  type='+''''+'unsubscribed'+''''+'/>';
                TOSendQueue.Put(str);
              end;
           end;
         end
       ////ïðèøëî ïîäòâåðæäåíèå àâòîðèçàöèè
       else if  (PresenceStock.Attributes['type']='subscribed')then
         begin
           //åñëè ïîäïèñêà  íå 'both' òî âûäàòü îêíî ñ ñîîáùåíèåì ÷òî ïîëüçîâàòåëü àâòîðèçîâàë
           if (puser.subscription <> 'both')then
             MessageDlg('Òåïåðü Âû àâòîðèçîâàíû '+user, mtInformation, [mbOK], 0);
         end
         else if  (PresenceStock.Attributes['type']='unsubscribed')then
         begin
           //åñëè ïîäïèñêà íå 'to' è íå 'both' òî âûäàòü îêíî ñ ñîîáùåíèåì ÷òî ïîëüçîâàòåëü àâòîðèçîâàë
          // if (puser.subscription = 'from')or(puser.subscription = 'none')then
             MessageDlg('Àâòîðèçàöèÿ îòìåíåíà '+user, mtInformation, [mbOK], 0);
             str := '<presence to='+''''+puser.jid+''''+'  type='+''''+'unsubscribed'+''''+'/>';
             TOSendQueue.Put(str);
         end;
       if (result) then
         begin
           //íàéòè îêíî ñ ðàçãîâîðîì è óêàçàòü òàì ñòàòóñ
           ind := OpenMessageWindows.IndexOf(user);
           if (ind >= 0) then
//              TShowMessages(OpenMessageWindows.Objects[ind]).ChangeStatus(ENG_STATUS[puser.status]);
                ShowMessages.ChangeStatus(puser);
         end;

      end; // if (ind >= 0)

    end; // if GetUserItemFromStr(user,puser)
end;

procedure TfMain.ChangeRoster;
var     ListItem: TListItem;
        i : integer;
        puser : PUserItem;
begin
  lvRoster.Clear;
  for i := 0 to UserList.Count-1 do
    begin
      ListItem :=lvRoster.Items.Add;
      ListItem.Caption := UserList[i];
      puser := PUserItem(UserList.Objects[i]);
      ListItem.Data := puser;
      if (puser.name_in_roster<>'')then
        ListItem.Caption :=puser.name_in_roster
      else
        ListItem.Caption := UserList[i];
      ListItem.ImageIndex := puser.status

    end;
end;

procedure TfMain.lvRosterDblClick(Sender: TObject);
var puser : PUserItem;

begin
  if (lvRoster.Selected <> nil) then
    begin
    //îòêðûòü îêíî äëÿ ðàçãîâîðà
      puser := PUserItem(lvRoster.Selected.Data);
      OpenMessageWindow(puser);
 end;
end;

procedure TfMain.SendMessage(to_user : string; msg : string);
var xml_str,msg_id: string;
begin
  msg_id :='msg_'+IntToStr(Random(1000));
  msg := UTF8Encode(msg);
  xml_str := ' <message to='+''''+to_user+''''+' type='+''''+'chat'+''''+' id='+''''+msg_id+''''+'><body>'+msg+'</body><x xmlns='+''''+'jabber:x:event'+''''+'><composing/></x></message> ';
  //memo1.Lines.Append(xml_str);
  ToSendQueue.Put(xml_str);
end;

procedure TfMain.ReceiveMessage(ReceiveStock: IXMLNode);
var puser : PUserItem;
    user, msg : string;
    ind, i : integer;
    newMessageForm : TShowMessages;
    BodyStock: IXMLNode;
begin
  puser := new(PUserItem);
 // user :=  ReceiveStock.Attributes['qw'];
  if (ReceiveStock.Attributes['to']= null) then  exit;
  //ïðîâåðÿåì íàì ëè ýòî ñîîáùåíèå
   user:= ReceiveStock.Attributes['to'];
    begin
      if GetUserItemFromStr(user,puser) then
        begin
          if (puser.jid = Login+'@'+Server) then
            //ñîîáùåíèå íàì
            begin
            ///îò êîãî
              user := ReceiveStock.Attributes['from'];
              if GetUserItemFromStr(user,puser) then
                begin
                  //èçâëå÷ü òåêñò
                  msg :='' ;
                  for i := 0 to ReceiveStock.ChildNodes.Count-1 do
                    if  ReceiveStock.ChildNodes[i].NodeName = 'body' then
                      msg := (ReceiveStock.ChildNodes[i].Text);
                 //     msg := UTF8Decode(msg);
                 { BodyStock := ReceiveStock.ChildNodes.Nodes['body'];
                  if (BodyStock = null) then   msg :='printing'
                  else msg :=BodyStock.Text;     }
                  //îòêðûòü îêíî ðàçãîâîðîâ
                 // ShowMessages.ShowInputMessage(msg,puser);
                 OpenMessageWindow(puser,msg);
                 //
                end;
           end;
        end;
    end;

end;


procedure TfMain.ReceiveIQ(IQStock: IXMLNode);
var puser : PUserItem;
    user, msg : string;
    ind, i : integer;
    newMessageForm : TShowMessages;
    BodyStock: IXMLNode;
begin
      puser := new(PUserItem);
 // user :=  ReceiveStock.Attributes['qw'];
  if (IQStock.Attributes['to']= null) then  exit;
  //ïðîâåðÿåì íàì ëè ýòî ñîîáùåíèå
  //
   user:= IQStock.Attributes['to'];
    begin
      if (user = FullJid) then
        //ñîîáùåíèå íàì
        begin
        //ïðîâåðÿåì àòðèáóò type
        if IQStock.Attributes['type'] = null  then
        else
          if (IQStock.Attributes['type'] = 'set') then
          //An IQ stanza of type "get" or "set" MUST contain one and only one child element that specifies the semantics of the particular request or response
            begin
                if IQStock.ChildNodes.Count = 1 then
                  if IQStock.ChildNodes[0].NodeName = 'query' then//query
                    if IQStock.ChildNodes[0].Attributes['xmlns'] = null  then
                    else
                      if IQStock.ChildNodes[0].Attributes['xmlns'] = 'jabber:iq:roster' then
                        if ReceiveIQ_Set_Roster(IQStock.ChildNodes[0])then  ChangeRoster;
            end
          else if (IQStock.Attributes['type'] = 'get') then
          //An IQ stanza of type "get" or "set" MUST contain one and only one child element that specifies the semantics of the particular request or response
            begin
            end
          else if (IQStock.Attributes['type'] = 'result') then
          //An IQ stanza of type "result" MUST include zero or one child elements.
            begin
            end
          else if (IQStock.Attributes['type'] = 'error') then
          //An IQ stanza of type "error" SHOULD include the child element contained in the associated "get" or "set" and MUST include an <error/> child;
            begin
            end;

         end;

    end;

end;


function TfMain.ReceiveIQ_Set_Roster(IQ_QueryStock: IXMLNode) : boolean;
var i,ind : integer;
    user : string;
    puser,puser2 : PUserItem;
begin
  result := false;
  for i := 0 to IQ_QueryStock.ChildNodes.Count-1 do
    begin
      if (IQ_QueryStock.ChildNodes[i].NodeName = 'item') then
        begin //äîáàâëåíèå èëè èçìåíåíèå êîíòàêòà
        //
        //  çàïîìíèòü êîíòàêò, åñëè òàêîé åñòü- âíåñòè èçìåíåíèÿ èëè óäàëèòü, åñëè íåò- äîáàâèòü
          if IQ_QueryStock.ChildNodes[i].Attributes['jid']= null then exit;
          user := IQ_QueryStock.ChildNodes[i].Attributes['jid'];
          puser := new(PUserItem);
          if GetUserItemFromStr(user,puser) then
            begin
              if (IQ_QueryStock.ChildNodes[i].Attributes['name']= null) then   puser.name_in_roster := puser.nick
              else  puser.name_in_roster := IQ_QueryStock.ChildNodes[i].Attributes['name'];
              //ñìîòðèì subscription
              if IQ_QueryStock.ChildNodes[i].Attributes['subscription']= null then
                else
                puser.subscription := IQ_QueryStock.ChildNodes[i].Attributes['subscription'];

                ind := UserList.IndexOf(puser.jid);
                if (ind >=0 )then //êîíòàêò óæå åñòü â ðîñòåðå
                  begin
                    if puser.subscription= 'remove' then
                      begin
                         //èñêàòü â ñïèñêå, åñëè åñòü- óäàëèòü
                         UserList.Delete(ind);
                         result := true;

                      end;
                    //èçìåíèòü
                    puser2 := PUserItem (UserList.Objects[ind]);
                    puser2.name_in_roster:=puser.name_in_roster;
                    puser2.subscription :=  puser.subscription;
                     if( puser2.subscription <> 'both') then puser2.status := STATUS_SUBSCRIBE_NOT_BOTH;
                    //Dispose(puser2);
                   // UserList.Objects[ind] := TObject(puser);
                    result := true;

                  end
                else //íàäî äîáàâèòü
                  begin
                    if puser.subscription= 'remove' then  exit;
                    if( puser.subscription = 'both') then puser.status := STATUS_OFF
                    else puser.status := STATUS_SUBSCRIBE_NOT_BOTH;
                    UserList.AddObject(user,TObject(puser));
                    result := true;
                    exit;
                  end
            end;
            
          Dispose(puser);
        end;

    end;
end;

procedure TfMain.CloseMessageWindow(to_user : string);
var ind : integer;
    MessageForm : TShowMessages;
begin
  ind := OpenMessageWindows.IndexOf(to_user);
  if (ind >= 0) then
    begin
       MessageForm := TShowMessages(OpenMessageWindows.Objects[ind]);
       OpenMessageWindows.Delete(ind);
       MessageForm.Free;
    end;
end;

procedure TfMain.OpenMessageWindow(puser : PUserItem; input_msg:string='');
var ind : integer;
    full_jid :string;
    newMessageForm : TShowMessages;
begin
 //åñëè ýòî èçåð èç íàøåãî ðîñòåðà, òî ïîëó÷àåì ñòàòóñ
 ind := UserList.IndexOf(puser.jid);
 if (ind >= 0) then puser := PUserItem(UserList.Objects[ind])
 else
    begin
      puser.status := STATUS_OFF;
      puser.name_in_roster := puser.nick;
    end;
 if puser.resource = Resource then  puser.isOur:= true
 else   puser.isOur:= false;
 if (input_msg <> '') then ShowMessages.ShowInputMessage(input_msg,puser)
 else  ShowMessages.OpenUser(puser);
 {//åñòü ëè óæå îòêðûòîå îêíî
     full_jid :=  puser.jid+'/'+puser.resource;
      ind := OpenMessageWindows.IndexOf(full_jid);
      if (ind >= 0) then
        begin
          //óæå åñòü îêíî
          newMessageForm := TShowMessages(OpenMessageWindows.Objects[ind]);
          if (input_msg <> '') then newMessageForm.ShowInputMessage(input_msg);
          newMessageForm.Show;
        end
      else
        begin
          //îòêðûâàåì íîâîå
          Application.CreateForm(TShowMessages, newMessageForm);
          OpenMessageWindows.AddObject(full_jid,newMessageForm);
          if (puser.resource =Resource) then newMessageForm.Init(true,Login,FullJid,puser.name_in_roster,full_jid)
          else newMessageForm.Init(false,Login,FullJid,puser.name_in_roster,full_jid);
           newMessageForm.ChangeStatus(ENG_STATUS[puser.status]);
          if (input_msg <> '') then newMessageForm.ShowInputMessage(input_msg);
         
          newMessageForm.Show;
        end;    }
end;


procedure TfMain.pumStatusPopup(Sender: TObject);
begin
//
//Memo1.Lines.Append( 'Popup: X- ' + IntToStr(PopupMenu1.PopupPoint.X)+'; Y- '+IntToStr(PopupMenu1.PopupPoint.y ));
end;
procedure TfMain.SendStatus(ind:integer);
var str : string;
//ind- èíäåêñ â ìàññèâå ENG_STATUS
begin
 BitBtn3.Caption:= ENG_STATUS[ind];
 if (ind < 5) then
  str := '<presence> <show>'+COMMAND_STATUS[ind]+'</show></presence>'
 else
  str := '<presence type='+''''+'unavailable'+''''+'></presence>';
 ToSendQueue.Put(str);
 BitBtn3.Glyph.Canvas.FillRect(Rect(0,0,16,16));
 ImageList1.GetBitmap(ind, BitBtn3.Glyph);
end;

procedure TfMain.Offline1Click(Sender: TObject);
begin
   if IdTCPClient1.Connected then
     SendStatus(TMenuItem(Sender).Tag)
   else //íàäî ïîäêëþ÷èòüñÿ è àâòîðèçàâàòüñÿ
      begin
      if fAuthorize.TryAuthorize then
        begin
          GetRoster;
          SendThread.Resume;
          ReceiveThread.Resume;
          SendStatus(TMenuItem(Sender).Tag);
        end;
      end;

end;

procedure TfMain.BitBtn3Click(Sender: TObject);
begin
   pumStatus.Popup(3+Panel1.Left+BitBtn3.Left+fMain.Left,BitBtn3.Top+Panel1.Top+fMain.Top+32-141);
 // BitBtn3.Down := false;
end;

procedure TfMain.AddRosterItemClick(Sender: TObject);
begin
fAddUser.AddUserInRoster(FullJid,ToSendQueue);
end;

procedure TfMain.BitBtn4Click(Sender: TObject);
begin
  pumMain.Popup(3+Panel1.Left+BitBtn4.Left+fMain.Left,BitBtn4.Top+Panel1.Top+fMain.Top+32);
end;

procedure TfMain.lvRosterKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var puser : PUserItem;
begin
if  lvRoster.SelCount=1 then
 if  (Key = VK_DELETE) then
   if MessageDlg('Are you sure you want to remove contact from your roster?', mtInformation,  [mbYes, mbNo], 0) = mrYes then
      //óäàëåíèå âûäåëåíîãî êîíòàêàòà
      begin
       puser := PUserItem(lvRoster.Selected.Data);
       if puser= nil then exit;
       if DelFromRoster(puser) then ChangeRoster;
      end;
end;

function TfMain.DelFromRoster(puser : PUserItem): boolean;
var str,iq_id : string;
    ind : integer;
begin
  result := false;
  //ïîòîì ñäåëàòü ñ ó÷åòîì ïîäòâåðæäåíèÿ îò ñåðâåðà
  //ïîñëàòü çàïðîñ
  iq_id :='roster_'+IntToStr(Random(1000));
  str := '<iq from='+''''+FullJid+''''+' type='+''''+'set'+''''+' id='+''''+iq_id+''''+'>';
  str := str + '<query xmlns='+''''+'jabber:iq:roster'+''''+'>';
  str := str +  '<item jid='+''''+puser.jid+''''+' subscription='+''''+'remove'+''''+'/>';
  str := str + '</query>';
  str := str + '</iq>';
  ToSendQueue.Put(str);
    //óäàëèòü èç ñïèñêà
  ind := UserList.IndexOfObject(TObject(puser));
  if (ind < 0) then //ïîèñêàòü åùå
  else
    begin
      UserList.Delete(ind);
      Dispose(puser);
      result := true;
    end;
end;

procedure TfMain.MyDisconnect;
//âûçûâàåòñÿ êîãäà ïðîèñõîäèò ïîòåðÿ ñîåäèíåíèÿ ñ ñåðâåðîì
var i : integer;
    puser : PUserItem;
begin
  //ñìåíèòü ñâîé ñòàòóñ íà offline
  BitBtn3.Caption:= ENG_STATUS[STATUS_OFF];
  BitBtn3.Glyph.Canvas.FillRect(Rect(0,0,16,16));
  ImageList1.GetBitmap(STATUS_OFF, BitBtn3.Glyph);
  //ñìåíèòü ñòàòóñ âñåõ ïîëüçîâàòåëåé â ðîñòåðå íà offline
  for i := 0 to UserList.Count-1 do
    begin
      puser :=  PUserItem(UserList.Objects[i]);
      puser.status :=  STATUS_OFF;
    end;
  ChangeRoster;
  //îñòàíîâèòü ïîòîêè
  SendThread.Suspend;
  ReceiveThread.Suspend;
end;


procedure TfMain.ClearUserList;
var i : integer;
    puser : PUserItem;
begin
    for i := 0 to UserList.Count-1 do
    begin
      puser :=  PUserItem(UserList.Objects[i]);
      Dispose(puser);
    end;
    UserList.Clear;
end;


procedure TfMain.Quit1Click(Sender: TObject);
begin
  QuitJabber;
end;

procedure TfMain.lvRosterMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

var p2 :TPoint;
begin
if Button=mbRight then
 if (lvRoster.Selected <> nil) then
    begin
      p2:= lvRoster.ClientOrigin;
      pumRosterItem.Popup(X+p2.X,Y+p2.Y);
    end;  
end;

procedure TfMain.SendMessage1Click(Sender: TObject);
var puser : PUserItem;
begin
  if  (lvRoster.Selected <> nil) then
    begin
      puser := PUserItem(lvRoster.Selected.Data);
      OpenMessageWindow(puser);
    end;
end;

procedure TfMain.Remove1Click(Sender: TObject);
var puser : PUserItem;
begin
  if  (lvRoster.Selected <> nil) then
    begin
      if MessageDlg('Are you sure you want to remove contact from your roster?', mtInformation,  [mbYes, mbNo], 0) = mrYes then
      //óäàëåíèå âûäåëåíîãî êîíòàêàòà
        begin
          puser := PUserItem(lvRoster.Selected.Data);
          if puser= nil then exit;
          if DelFromRoster(puser) then ChangeRoster;
        end;
    end;
end;

procedure TfMain.Resendauthorizationto1Click(Sender: TObject);
var puser : PUserItem;
    str :string;
begin
  if  (lvRoster.Selected <> nil) then
    begin
      puser := PUserItem(lvRoster.Selected.Data);
      if puser= nil then exit;
      str := '<presence to='+''''+puser.jid+''''+'  type='+''''+'subscribed'+''''+'/>';
      TOSendQueue.Put(str);
      ShowMessage('Sent authorization to '+puser.jid+' ('+puser.name_in_roster+')' );
    end;
end;

procedure TfMain.Rerequestauthorizationfrom1Click(Sender: TObject);
var puser : PUserItem;
    str :string;
begin
  if  (lvRoster.Selected <> nil) then
    begin
      puser := PUserItem(lvRoster.Selected.Data);
      if puser= nil then exit;
      str := '<presence to='+''''+puser.jid+''''+'  type='+''''+'subscribe'+''''+'/>';
      TOSendQueue.Put(str);
      ShowMessage(' Rerequested authorization from '+puser.jid+' ('+puser.name_in_roster+')' );
    end;
end;

procedure TfMain.Removeauthorizationfrom1Click(Sender: TObject);
var puser : PUserItem;
    str :string;
begin
  if  (lvRoster.Selected <> nil) then
    begin
       if MessageDlg('Are you sure you want to remove authorization?', mtInformation, [mbYes, mbNo], 0) = mrYes then
        begin
          puser := PUserItem(lvRoster.Selected.Data);
          if puser= nil then exit;

          str := '<presence to='+''''+puser.jid+''''+'  type='+''''+'unsubscribed'+''''+'/>';
          TOSendQueue.Put(str);
          ShowMessage('Authorization removed from '+puser.jid+' ('+puser.name_in_roster+')' );
        end;  
    end;
end;

procedure TfMain.Rename1Click(Sender: TObject);
var str,iq_id: string;
    newfRename: TfRename;
    puser : PUserItem;
begin
  if  (lvRoster.Selected <> nil) then
    if  (lvRoster.SelCount = 1) then
      begin
        puser := PUserItem(lvRoster.Selected.Data);
        Application.CreateForm(TfRename, newfRename);
        if newfRename.RenameContact(puser.name_in_roster)then
          begin
            iq_id :='roster_'+IntToStr(Random(1000));
            str := '<iq from='+''''+FullJid+''''+' type='+''''+'set'+''''+' id='+''''+iq_id+''''+'>';
            str := str + '  <query xmlns='+''''+'jabber:iq:roster'+''''+'>';
            str := str + '       <item jid='+''''+puser.jid+'''';
            str := str +' name='+''''+puser.name_in_roster+''''+'>';
             //ãðóïïà....
             //çàêðûòü âñå òåãè
              str := str + '       </item>     </query>   </iq>';
              TOSendQueue.Put(str);
            
          end;
        newfRename.Free;  
        //showMessage('!!!');
      end;
end;

procedure TfMain.lvRosterEdited(Sender: TObject; Item: TListItem;
  var S: String);
var puser : PUserItem;
begin
  puser := PUserItem(Item.Data);
  if puser= nil then exit;
  lvRoster.ReadOnly := true;
end;

procedure TfMain.RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ShowWindow(Handle, SW_SHOW);
end;

procedure TfMain.ShowJabber1Click(Sender: TObject);
begin
ShowWindow(Handle, SW_SHOW);
end;

procedure TfMain.QuitJabber;
begin
must_close:= true;
if IdTCPClient1.Connected then
  ToSendQueue.Put('</stream:stream>')
else
  fMain.Close;
end;

procedure TfMain.CloseJabber1Click(Sender: TObject);
begin
  QuitJabber;
end;

end.