Indy10 即时通讯Demo

最近闲来无事，重新学习了Indy10，顺手写了一段即时通讯代码。与上次写的笔记有不同之处，但差别不大。

未研究过TCP打洞技术，所以下面的代码采用的是客户端--服务器--客户端模式，也就是服务器端转发消息的模式。

客户端模仿了QQ，可以在屏幕四周停靠自动隐藏

本文也演示了在线程中操作VCL的两张方法：

1：向主线程发送消息

2：在线程中使用临界区

program Server;

uses

  Forms,

  UntMain in 'UntMain.pas' {Form2},

  Unit2 in 'Unit2.pas',

  Unit4 in 'Unit4.pas';

{$R *.res}

begin

  Application.Initialize;

  Application.MainFormOnTaskbar := True;

  Application.CreateForm(TForm2, Form2);

  Application.Run;

end.

服务器端：

unit UntMain;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdContext, IdScheduler, IdSchedulerOfThread, IdSchedulerOfThreadPool,

  IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, ImgList,

  CoolTrayIcon, ExtCtrls, RzPanel, Unit2, IdGlobal, StdCtrls, RzLstBox,

  IdSchedulerOfThreadDefault, RzStatus, RzButton, RzEdit,SyncObjs;

type

  TForm2 = class(TForm)

    CoolTrayIcon1: TCoolTrayIcon;

    ImageList1: TImageList;

    IdTCPServer1: TIdTCPServer;

    RzStatusBar1: TRzStatusBar;

    RzListBox1: TRzListBox;

    IdSchedulerOfThreadDefault1: TIdSchedulerOfThreadDefault;

    Button1: TButton;

    RzStatusPane1: TRzStatusPane;

    RzStatusPane2: TRzStatusPane;

    RzMemo1: TRzMemo;

    RzButton1: TRzButton;

    RzMemo2: TRzMemo;

    Timer1: TTimer;

    procedure IdTCPServer1Execute(AContext: TIdContext);

    procedure CustomMessage(var message: TMessage); message CustMsg;

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Button1Click(Sender: TObject);

    procedure IdTCPServer1Disconnect(AContext: TIdContext);

    procedure RzButton1Click(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

  //TIdServerContext 类继承自 TIdContext类

  //IdCustomTCPServer 单元 第295行

  TMyClass = class(TIdServerContext)

    CltInfo: TCltInfo;

  end;

var

  Form2: TForm2;

  CriticalSection:TCriticalSection;

implementation

{$R *.dfm}

uses

  Unit4;

procedure TForm2.Button1Click(Sender: TObject);

begin

  IdTCPServer1.Active := True;

  if IdTCPServer1.Active then

  begin

    RzMemo1.Lines.Add('服务器开启成功...');

  end;

end;

procedure TForm2.CustomMessage(var message: TMessage);

var

  i,n: Integer;

  ss,ip,Nc,sNc: string;

  buf:TDataPack;

  list:Tlist;

  FContext:TIdContext;

begin

  FContext := TMyClass(message.LParam);

  case message.WParam of

    CltConnect:

    begin

      ss:='';

      Nc := TMyClass(FContext).CltInfo.CltName;

      ip:= TMyClass(FContext).CltInfo.CltIP;

      RzListBox1.Items.Add(Nc);

      RzMemo2.Lines.Add('【客户:】' + Nc + ' (' + ip +') 登陆'+'---'+DateTimeToStr(Now));

      for i := 0 to RzListBox1.Items.Count - 1 do // 发送连线客户端列表

        ss:=ss+form2.RzListBox1.ItemCaption(i)+'|';

      sNc :=Encrystrings(ss);

      FillChar(buf, SizeOf(TDataPack), '');

      buf.Command := CltList;

      StrCopy(@buf.Data, PChar(sNc));

      List := form2.IdTCPServer1.Contexts.LockList;

      n:= List.Count;

      try

        for I := 0 to n-1 do

        begin

          try

            TMyClass(List.Items[i]).Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

          except

            //

          end;

        end;

      finally

        form2.IdTCPServer1.Contexts.UnlockList;

      end;

    end;

    CltDisconnect:

      begin

        for i := 0 to RzListBox1.Items.Count - 1 do

        begin

          if RzListBox1.ItemCaption(i) = TMyClass(FContext).CltInfo.CltName  then

          begin

            RzListBox1.Items.Delete(i);

            RzMemo2.Lines.Add('【用户:】 '+ string(TMyClass(FContext).CltInfo.CltName) +'  离开---'+DateTimeToStr(Now));

            Break;

          end;

        end;

        FillChar(buf, SizeOf(TDataPack), '');

        ss := '';

        for i := 0 to RzListBox1.Items.Count - 1 do // 发送连线客户端列表

          ss := ss + Form2.RzListBox1.ItemCaption(i) + '|';

        ss:=Encrystrings(ss);

        buf.Command := CltList;

        StrCopy(@buf.Data, PChar(ss));

        list:= IdTCPServer1.Contexts.LockList;

        n:= List.Count;

        try

          for i := 0 to n - 1 do

          try

            TMyClass(List.Items[i]).Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

          except

            //

          end;

        finally

          IdTCPServer1.Contexts.UnlockList;

        end;

      end;

    CltSendMessage:

      begin

      end;

  end;

end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  RzListBox1.Clear;

  IdTCPServer1.Active := False;

end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

var

  List:TList;

  i,n:Integer;

  LContext: TMyClass;

  buf:TDataPack;

begin

  //当有客户端尚未断开连接时，服务器主动断开连接会导致异常

  //所以，在服务器端退出之前，检查时候有客户端尚未断开

  //若有，通知客户端主动断开连接

  List:= IdTCPServer1.Contexts.LockList;

  n:= List.Count;

  try

    if n >0 then

    begin

      CanClose := False;

      FillChar(buf,SizeOf(TdataPack),'');

      buf.Command := SrvCloseQuery;

      for I := 0 to n - 1 do

      begin

        LContext := TMyClass(List.Items[i]);

        LContext.Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

      end;

    end else CanClose := True;

  finally

    IdTCPServer1.Contexts.UnlockList;

  end;

end;

procedure TForm2.FormCreate(Sender: TObject);

begin

  //在IdCustomTCPServer 单元第302行，定义了类的指针:

  //TIdServerContextClass = class of TIdServerContext;

  //AContext不确定以 TIdServerContext类创建，所以定义了一个类的指针TIdServerContextClass，

  //AContext将以TIdServerContextClass指针所指向的类来创建,重新赋值指针，将以新类创建实例

  //这里重新赋值AContext 新类，当客户端连接后，AContext将以新类TMyClass的实例创捷

  //AContext 被创建后，将包含TMyClass类的新属性 TCltInfo

  //详见IdCustomTCPServer 单元第956行

  //如果不重新赋值AContext新类，AContext 在IdCustomTCPServer初始化时(TIdCustomTCPServer.InitComponent方法)，

  //以默认类TIdServerContext创建

  //详见 IdCustomTCPServer 单元第812行

  //这里我们需要给AContext 添加新属性 TCltInfo 用来保存客户端信息

  //所以，以TIdServerContext 为基类，我们扩展出  TMyClass 子类

  //每个客户端连接后，AContext即被创建，并把每个AContext地址(对象指针)保存在IdTCPServer.Contexts属性中

  //当服务器端需要与某个客户端回话时，可以遍历Contexts属性

  IdTCPServer1.ContextClass := TMyClass;

  IdTCPServer1.Active := True;

  if IdTCPServer1.Active then

  begin

    RzMemo1.Lines.Add('服务器开启成功...('+ DateTimeToStr(Now) + ')');

  end;

  CriticalSection:=TCriticalSection.Create;

end;

procedure TForm2.FormDestroy(Sender: TObject);

begin

  CriticalSection.Free;

end;

procedure TForm2.IdTCPServer1Disconnect(AContext: TIdContext);

begin

  SendMessage(Handle,CustMsg,CltDisconnect,LongInt(AContext));

end;

procedure TForm2.IdTCPServer1Execute(AContext: TIdContext);

var

  BByte: TIdBytes;

  buf: TDataPack;

  i,n: Integer;

  s,ss,ds,nr,Nc,ip:string;

  List:Tlist;

begin

  FillChar(buf, SizeOf(TDataPack), '');

  AContext.Connection.IOHandler.ReadBytes(BByte, SizeOf(TDataPack), False);

  BytesToRaw(BByte, buf, SizeOf(TDataPack));

//---------------------------------------------------------------------------------------

  case buf.Command of

    CltConnect:

      begin

        ss:='';

        s:= string(buf.CltInfo.CltName);

        Nc :=Uncrystrings(s);

        ip:=AContext.Binding.PeerIP;

        StrCopy(@TMyClass(AContext).CltInfo.CltName,PChar(Nc)) ;

        StrCopy(@TMyClass(AContext).CltInfo.CltIP,PChar(ip));

        Nc :=Uncrystrings(s);

        for i := 0 to RzListBox1.Items.Count - 1 do

        begin

          if RzListBox1.Items[i]=Nc then

          begin

            buf.Command := CltDisconnect;

            AContext.Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

            Exit;

          end;

        end;

        SendMessage(Handle,CustMsg,CltConnect,LongInt(AContext));

      end;

//------------------------------------------------------------------------------------------------

    CltSendMessage:

      begin

        s:= Uncrystrings(string(buf.CltInfo.CltName));

        ds:=Uncrystrings(string(buf.DstInfo.CltName));

        nr:=Uncrystrings(string(buf.Data)) +#13+#10;

        List := form2.IdTCPServer1.Contexts.LockList;

        n:= List.Count;

        try

          for i := 0 to n - 1 do

          begin

            if TMyClass(List.Items[i]).CltInfo.CltName = ds then

            begin

              try

                CriticalSection.Enter;

                try

                  TMyClass(List.Items[i]).Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

                  RzMemo1.Lines.Add(s + '对 '+ds + ' 说：'+ nr);

                finally

                  CriticalSection.Leave;

                end;

              except

                buf.Command := SrvMessage;

                AContext.Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

              end;

              Exit;

            end;

          end;

        finally

          form2.IdTCPServer1.Contexts.UnlockList;

        end;

      end;

//--------------------------------------------------------------------------------------------------------

    CltTimer :

    begin

      AContext.Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

    end;

//---------------------------------------------------------------------------------------------------------

    CltClear :

    begin

      s:= Uncrystrings(string(buf.CltInfo.CltName));

      ds:=Uncrystrings(string(buf.DstInfo.CltName));

      List := form2.IdTCPServer1.Contexts.LockList;

      n:= List.Count;

      try

        for i := 0 to n - 1 do

        begin

          if TMyClass(List.Items[i]).CltInfo.CltName = ds then

          begin

            try

              CriticalSection.Enter;

              try

                TMyClass(List.Items[i]).Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

                RzMemo1.Lines.Add(s + ' 清除了 '+ds + ' 的屏幕'+#13+#10);

              finally

                CriticalSection.Leave;

              end;

            except

              //

            end;

            Exit;

          end;

        end;

      finally

        form2.IdTCPServer1.Contexts.UnlockList;

      end;

    end;

//-------------------------------------------------------------------------------------------------------

    CltLockSrc:

    begin

      s:= Uncrystrings(string(buf.CltInfo.CltName));

      List := form2.IdTCPServer1.Contexts.LockList;

      n:= List.Count;

      try

        for i := 0 to n - 1 do

        begin

          if TMyClass(List.Items[i]).CltInfo.CltName <> s then

          begin

            try

              CriticalSection.Enter;

              try

                TMyClass(List.Items[i]).Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

              finally

                CriticalSection.Leave;

              end;

            except

              //

            end;

          end;

        end;

      finally

        form2.IdTCPServer1.Contexts.UnlockList;

      end;

      RzMemo1.Lines.Add(s + ' 锁定了屏幕 '+#13+#10);

    end;

//-------------------------------------------------------------------------------------------------------

    CltUnlockSrc :

    begin

      s:= Uncrystrings(string(buf.CltInfo.CltName));

      List := form2.IdTCPServer1.Contexts.LockList;

      n:= List.Count;

      try

        for i := 0 to n - 1 do

        begin

          if TMyClass(List.Items[i]).CltInfo.CltName <> s then

          begin

            try

              TMyClass(List.Items[i]).Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

            except

              //

            end;

          end;

        end;

      finally

        form2.IdTCPServer1.Contexts.UnlockList;

      end;

      RzMemo1.Lines.Add(s + ' 解锁了屏幕 '+#13+#10);

    end;

//---------------------------------------------------------------------------------------------------------------

    CltMessage :

    begin

      ds:=Uncrystrings(string(buf.DstInfo.CltName));

      List := form2.IdTCPServer1.Contexts.LockList;

      n:= List.Count;

      try

      for i := 0 to n - 1 do

      begin

        if TMyClass(List.Items[i]).CltInfo.CltName = ds then

        begin

          try

            TMyClass(List.Items[i]).Connection.IOHandler.Write(RawToBytes(buf, SizeOf(TDataPack)), SizeOf(TDataPack));

          except

            //

          end;

          Exit;

        end;

      end;

      finally

        form2.IdTCPServer1.Contexts.UnlockList;

      end;

    end;

//-----------------------------------------------------------------------------------------------------------------

  end;

end;

procedure TForm2.RzButton1Click(Sender: TObject);

begin

  RzMemo1.Clear;

end;

end.

　　客户端

program Project3;

uses

  Forms,

  windows,

  Unit3 in 'Unit3.pas' {Form3},

  Unit1 in 'Unit1.pas' {Form1},

  Unit2 in 'Unit2.pas',

  Unit4 in 'Unit4.pas';

{$R *.res}

begin

  Application.Initialize;

  Application.MainFormOnTaskbar := False ;

  Application.CreateForm(TForm3, Form3);

  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);

  Application.Run;

end.

unit Unit3;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, RzLstBox, ExtCtrls, ShellAPI, ImgList, RzTray, IdGlobal,

  Unit2,Clipbrd,

  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, RzButton,

  RzRadChk, RzPanel, Mask, RzEdit, RzLabel, ComCtrls, Menus, RzBHints, RzSplit,

  RzAnimtr, IdZLibCompressorBase, IdCompressorZLib,RxRichEd, RzListVw,Buttons,

  RzSpnEdt ;

type

  TForm3 = class(TForm)

    RzListBox1: TRzListBox;

    Timer1: TTimer;

    RzTrayIcon1: TRzTrayIcon;

    ImageList1: TImageList;

    IdTCPClient1: TIdTCPClient;

    RzCheckBox1: TRzCheckBox;

    RzPanel1: TRzPanel;

    RzPanel2: TRzPanel;

    RzMemo2: TRzMemo;

    RzLabel1: TRzLabel;

    RzEdit1: TRzEdit;

    RzButton2: TRzButton;

    RzLabel2: TRzLabel;

    RzEdit2: TRzEdit;

    Timer2: TTimer;

    PopupMenu1: TPopupMenu;

    N1: TMenuItem;

    RzButton3: TRzButton;

    BalloonHint1: TBalloonHint;

    RzLabel5: TRzLabel;

    RzEdit3: TRzEdit;

    RzSplitter1: TRzSplitter;

    RzSplitter2: TRzSplitter;

    RzAnimator1: TRzAnimator;

    ImageList2: TImageList;

    RzToolButton1: TRzToolButton;

    PopupMenu2: TPopupMenu;

    N2: TMenuItem;

    N3: TMenuItem;

    N4: TMenuItem;

    ImageList3: TImageList;

    RzButton4: TRzButton;

    RzButton5: TRzButton;

    RxRichEdit1: TRxRichEdit;

    LabeledEdit1: TLabeledEdit;

    RzPanel3: TRzPanel;

    Image01: TImage;

    Image02: TImage;

    Image03: TImage;

    Image04: TImage;

    Image05: TImage;

    Image06: TImage;

    Image07: TImage;

    Image08: TImage;

    Image09: TImage;

    Image10: TImage;

    Image11: TImage;

    Image12: TImage;

    Image13: TImage;

    Image14: TImage;

    Image15: TImage;

    Image16: TImage;

    Image17: TImage;

    Image18: TImage;

    Image19: TImage;

    Image20: TImage;

    Image21: TImage;

    Image22: TImage;

    Image23: TImage;

    Image24: TImage;

    Image25: TImage;

    Image26: TImage;

    Image27: TImage;

    Image28: TImage;

    Image29: TImage;

    Image30: TImage;

    Image31: TImage;

    Image32: TImage;

    Image33: TImage;

    Image34: TImage;

    Image35: TImage;

    Image36: TImage;

    Image37: TImage;

    Image38: TImage;

    Image39: TImage;

    Image40: TImage;

    Image41: TImage;

    Image42: TImage;

    Image43: TImage;

    Image44: TImage;

    Button1: TButton;

    RzButton1: TRzButton;

    ScrollBox1: TScrollBox;

    Image1: TImage;

    Image45: TImage;

    Image46: TImage;

    Image47: TImage;

    Image48: TImage;

    Image49: TImage;

    Image50: TImage;

    Image51: TImage;

    Timer3: TTimer;

    Image2: TImage;

    FontDialog1: TFontDialog;

    procedure FormCreate(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

    procedure WMMOVING(var Msg: TMessage); message WM_MOVING;

    procedure wmsizing(var Msg: TMessage); message WM_SIZING;

    procedure RevCustMsg(var Msg:TMessage);message CustMsg;

    procedure SetBarHeight;

    procedure RzListBox1DblClick(Sender: TObject);

    procedure RzCheckBox1Click(Sender: TObject);

    procedure IdTCPClient1Connected(Sender: TObject);

    procedure IdTCPClient1Disconnected(Sender: TObject);

    procedure RzButton1Click(Sender: TObject);

    procedure RzButton2Click(Sender: TObject);

    procedure RzMemo2KeyPress(Sender: TObject; var Key: Char);

    procedure Timer2Timer(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure RzTrayIcon1RestoreApp(Sender: TObject);

    procedure RzTrayIcon1MinimizeApp(Sender: TObject);

    procedure RzMemo2MouseEnter(Sender: TObject);

    procedure FormMouseEnter(Sender: TObject);

    function MousePosion:Boolean;

    procedure RzListBox1MouseEnter(Sender: TObject);

    procedure N1Click(Sender: TObject);

    procedure RzButton3Click(Sender: TObject);

    procedure LabeledEdit1KeyPress(Sender: TObject; var Key: Char);

    procedure RzEdit3KeyPress(Sender: TObject; var Key: Char);

    procedure RzEdit1KeyPress(Sender: TObject; var Key: Char);

    procedure PopupMenu1Popup(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure RzButton4Click(Sender: TObject);

    procedure RzButton5Click(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

    procedure RxRichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure Image01Click(Sender: TObject);

    procedure RzSpinButtons1DownLeftClick(Sender: TObject);

    procedure RzSpinButtons1UpRightClick(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure RxRichEdit1URLClick(Sender: TObject; const URLText: string;

      Button: TMouseButton);

    procedure Image1Click(Sender: TObject);

    function  MouseInScrollBox:Boolean;

    procedure Timer3Timer(Sender: TObject);

    procedure Image2Click(Sender: TObject);

  private

    { Private declarations }

    FAnchors: TAnchors;

  public

    { Public declarations }

  end;

  TRevDataThread = class(TThread)

  private

    buf: TDataPack;

  protected

    procedure Execute; override;

    procedure ShowMsg;

    procedure AddCltList;

    procedure DoDiscnt;

    procedure ClearScr;

    procedure AddMessage;

    procedure CltMessageIn;

    procedure DoSrvMessage;

    procedure DoSrvCloseQuery;

  end;

  // HidePosKind = (hpTop, hpLeft, hpBottom, hpRight);

  // THidePos = set of HidePosKind;

var

  Form3: TForm3;

  Lst_Height: Integer; // 记录窗体隐藏前的高度

  Lst_Width: Integer; // 记录窗体隐藏前的宽度

  Rec_Position: Boolean; // 是否启动窗体宽高记录标志

  Cur_Top, Cur_Bottom: Integer; // 隐藏后窗体的顶端和底部位置

  RevDataThread:TRevDataThread;

  BoolEnable:Boolean;

implementation

uses Math, types, Unit1,StrUtils,Unit4;

{$R *.dfm}

procedure TForm3.WMMOVING(var Msg: TMessage);

begin

  inherited;

  with PRect(Msg.LParam)^ do

  begin

    if (akLeft in FAnchors) or (akRight in FAnchors) then

    begin

      if (Left > 0) and (Right < Screen.Width) then

      begin

        if Rec_Position then

        begin

          Bottom := top + Lst_Height;

          Right := Left + Lst_Width;

          Height := Lst_Height;

          Width := Lst_Width;

        end;

      end

      else

      begin

        SetBarHeight;

        top := Cur_Top;

        Bottom := Cur_Bottom;

        exit;

      end;

    end;

    Left := Min(Max(0, Left), Screen.Width - Width);

    top := Min(Max(0, top), Screen.Height - Height);

    Right := Min(Max(Width, Right), Screen.Width);

    Bottom := Min(Max(Height, Bottom), Screen.Height);

    if not Rec_Position then

    begin

      Lst_Height := Form3.Height;

      Lst_Width := Form3.Width;

    end;

    FAnchors := [];

    if Left = 0 then

      Include(FAnchors, akLeft);

    if Right = Screen.Width then

      Include(FAnchors, akRight);

    if top = 0 then

      Include(FAnchors, akTop);

    if Bottom = Screen.Height then

      Include(FAnchors, akBottom);

    Timer1.Enabled := FAnchors <> [];

    if (akLeft in FAnchors) or (akRight in FAnchors) then

    begin

      Rec_Position := True;

      SetBarHeight;

      top := Cur_Top;

      Bottom := Cur_Bottom;

    end

    else

      Rec_Position := False;

    Timer1.Enabled := FAnchors <> [];

  end;

end;

procedure TForm3.Button1Click(Sender: TObject);

var

  c:TComponent;

  s:string;

begin

  s:='01';

  c:= FindComponent('Image'+s);

            Clipboard.Assign(TImage(c).Picture);

            RxRichEdit1.PasteFromClipboard;

end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if Assigned(RevDataThread) then FreeAndNil(RevDataThread);

  IdTCPClient1.Disconnect;

end;

procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

  CanClose := False;

  RzButton3.Click;

end;

procedure TForm3.FormCreate(Sender: TObject);

begin

  Timer1.Enabled := False;

  Timer1.Interval := 200;

  //FormStyle := fsStayOnTop;

  BoolEnable:= False;

  RzListBox1.Clear;

  UnLcokTimes :=0;

  LockStatus := False;

  RxRichEdit1.Paragraph.LineSpacingRule:=lsSpecified;

  RxRichEdit1.Paragraph.LineSpacing:=20;

  ScrollBox1.VertScrollBar.Position :=0;

end;

procedure TForm3.FormMouseEnter(Sender: TObject);

begin

  RzTrayIcon1.Animate := False;

  RzTrayIcon1.IconIndex := 0;

end;

procedure TForm3.Timer1Timer(Sender: TObject);

const

  cOffset = 2;

begin

  if MousePosion then

  begin

    if akLeft in FAnchors then

      Left := 0;

    if akTop in FAnchors then

      top := 0;

    if akRight in FAnchors then

      Left := Screen.Width - Width;

    if akBottom in FAnchors then

      top := Screen.Height - Height;

  end

  else

  begin

    if akLeft in FAnchors then

    begin

      Left := -Width + cOffset;

      SetBarHeight;

      top := Cur_Top;

      Height := Cur_Bottom;

    end;

    if akTop in FAnchors then

      top := -Height + cOffset;

    if akRight in FAnchors then

    begin

      Left := Screen.Width - cOffset;

      SetBarHeight;

      top := Cur_Top;

      Height := Cur_Bottom;

    end;

    if akBottom in FAnchors then

      top := Screen.Height - cOffset;

  end;

end;

procedure TForm3.Timer2Timer(Sender: TObject);

var

  buf:TDataPack;

  bbyte:TIdBytes;

begin

  FillChar(buf,SizeOf(TDataPack),'');

  buf.Command := CltTimer;

  BByte := RawToBytes(buf, SizeOf(TDataPack));

  try

    IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

  except

    Timer2.Enabled := False;

    RzAnimator1.Animate := False;

    RzAnimator1.ImageIndex :=1;

    ShowMessage('与服务器断开连接');

  end;

end;

procedure TForm3.Timer3Timer(Sender: TObject);

begin

  if not MouseInScrollBox  then

  begin

    if ScrollBox1.Visible  then ScrollBox1.Visible := False;

  end;

  Timer3.Enabled := ScrollBox1.Visible;

end;

procedure TForm3.IdTCPClient1Connected(Sender: TObject);

//var

//  BByte: TIdBytes;

//  buf: TDataPack;

begin

//  FillChar(buf, SizeOf(TDataPack), '');

//  buf.Command := CltConnect;

//  buf.CltInfo.CltName := 'ZZPC';

//  BByte := RawToBytes(buf, SizeOf(TDataPack));

//  IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

//  if Assigned(RevDataThread)  then RevDataThread.Terminate;

end;

procedure TForm3.IdTCPClient1Disconnected(Sender: TObject);

begin

  if Assigned(RevDataThread)  then RevDataThread.Terminate;

  RzListBox1.Items.Clear;

  RzEdit2.ReadOnly := False;

  RzToolButton1.Enabled := False;

  RzButton4.Enabled := False;

  RzCheckBox1.Checked := False;

end;

procedure TForm3.Image01Click(Sender: TObject);

var

  s:String;

begin

  s:=RightStr(TImage(Sender).Name,2);

  RzMemo2.Text := '['+s+']';

  ScrollBox1.Visible := False;

  RzToolButton1.Click;

end;

procedure TForm3.Image1Click(Sender: TObject);

begin

  ScrollBox1.Visible := not ScrollBox1.Visible;

  Timer3.Enabled := ScrollBox1.Visible;

end;

procedure TForm3.Image2Click(Sender: TObject);

begin

  if FontDialog1.Execute then  RxRichEdit1.Font := FontDialog1.Font;

end;

procedure TForm3.LabeledEdit1KeyPress(Sender: TObject; var Key: Char);

begin

  if ((Key = #13) and (((hi(GetKeyState(VK_CONTROL))) and $80) <> $80))  then

  begin

    Key :=#0;

    RzButton3.Click;

  end;

end;

function TForm3.MouseInScrollBox: Boolean;

begin

  Result := False;

  if WindowFromPoint(Mouse.CursorPos) = ScrollBox1.Handle then Result := True;

end;

function TForm3.MousePosion: Boolean;

begin

  Result := False;

  if (WindowFromPoint(Mouse.CursorPos) = Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzListBox1.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzPanel1.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzPanel2.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RxRichEdit1.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzMemo2.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzCheckBox1.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzEdit1.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzEdit2.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzEdit3.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzAnimator1.Handle)  or

    (WindowFromPoint(Mouse.CursorPos) = RzButton2.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzButton3.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzSplitter1.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzSplitter2.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = LabeledEdit1.Handle)  or

    (WindowFromPoint(Mouse.CursorPos) = RzButton4.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzButton5.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = RzPanel3.Handle) or

    (WindowFromPoint(Mouse.CursorPos) = ScrollBox1.Handle) then

    Result := True;

end;

procedure TForm3.N1Click(Sender: TObject);

begin

  RzButton5.Click;

end;

procedure TForm3.N4Click(Sender: TObject);

begin

  RzButton3.Click;

end;

procedure TForm3.PopupMenu1Popup(Sender: TObject);

begin

  N3.Visible :=RzButton3.Caption = '锁定';

  N4.Visible := RzButton3.Caption = '锁定';

end;

procedure TForm3.RevCustMsg(var Msg: TMessage);

var

  s:string;

  buf:TDataPack;

begin

  FillChar(buf,SizeOf(TDataPack),'');

  s:=string(PDatapack(Pointer(msg.LParam))^.Data);

  form1.RzMemo1.Lines.Add(s);

end;

procedure TForm3.RxRichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if RzTrayIcon1.Animate  then

  begin

    RzTrayIcon1.Animate := False;

    RzTrayIcon1.IconIndex := 0;

  end;

end;

procedure TForm3.RxRichEdit1URLClick(Sender: TObject; const URLText: string;

  Button: TMouseButton);

begin

  ShellExecute(Application.Handle, nil, PChar(URLText), nil, nil, SW_SHOWNORMAL);

end;

procedure TForm3.RzButton1Click(Sender: TObject);

var

  buf:TDataPack;

  Bbyte:TIdBytes;

  s,tm,bm:string;

  pt:TPoint;

  ctl:TComponent;

begin

  if Trim(RzMemo2.Text) <>'' then

  begin

    if RzListBox1.ItemIndex <> -1 then

    begin

      s:=RzListBox1.SelectedItem;

      if s= form3.RzEdit2.Text then

      begin

        RzListBox1.CustomHint.Title :='提示';

        RzListBox1.CustomHint.Description :='您不能跟自己聊天，那是欲魔行为！';

        pt.X :=RzListBox1.Width div 2;

        pt.Y :=RzListBox1.Height div 6;

        RzListBox1.CustomHint.ImageIndex :=1;

        RzListBox1.CustomHint.HideAfter :=5000;

        RzListBox1.CustomHint.ShowHint(RzListBox1.ClientToScreen(pt));

        Exit;

      end;

      FillChar(buf, SizeOf(TDataPack), '');

      buf.Command := CltSendMessage;

      StrCopy(@buf.CltInfo.CltName, PChar(Encrystrings(form3.RzEdit2.Text)));

      StrCopy(@buf.DstInfo.CltName, PChar(Encrystrings(s)));

      tm:= RzMemo2.Text + '   (' +datetimetostr(Now)+ ')';

      StrCopy(@buf.Data, PChar(Encrystrings(tm)));

      BByte := RawToBytes(buf, SizeOf(TDataPack));

      try

        IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

        if CheckBmp(tm) then

        begin

          bm := Copy(tm,2,2);

          RxRichEdit1.Lines.Add('你对 ' +RzListBox1.SelectedItem + ' 说：');

          ctl:= FindComponent('Image'+bm);

          //ShowMessage(TImage(ctl).Name);

          if ctl <> nil then

          begin

            Clipboard.Assign(TImage(ctl).Picture);

            RxRichEdit1.PasteFromClipboard;

          end;

        end else RxRichEdit1.Lines.Add('你对 '+ RzListBox1.SelectedItem + '说: '+ tm);

        PostMessage(RxRichEdit1.Handle, WM_VSCROLL, SB_BOTTOM, 0);

        RzMemo2.Clear;

      except

//        if not  IdTCPClient1.IOHandler.Opened  then

//        begin

          ShowMessage('已与服务器断开连接,消息发送不成功');

          RzListBox1.Items.Clear;

          RzEdit2.ReadOnly := False;

          RzToolButton1.Enabled := False;

          RzButton4.Enabled := False;

          RzCheckBox1.Checked := False;

//        end;

      end;

    end  else begin

      RzListBox1.CustomHint.Title :='提示';

      RzListBox1.CustomHint.Description :='请在这里选择一个聊天对象';

      pt.X :=RzListBox1.Width div 2;

      pt.Y :=RzListBox1.Height div 6;

      RzListBox1.CustomHint.ImageIndex :=1;

      RzListBox1.CustomHint.HideAfter :=3000;

      RzListBox1.CustomHint.ShowHint(RzListBox1.ClientToScreen(pt));

    end;

  end else begin

    RzMemo2.CustomHint.Title :='提示';

    RzMemo2.CustomHint.Description :='不能发送空消息哦';

    pt.X :=RzMemo2.Width div 2;

    pt.Y :=RzMemo2.Height div 2;

    RzMemo2.CustomHint.ImageIndex :=0;

    RzMemo2.CustomHint.HideAfter :=2000;

    RzMemo2.CustomHint.ShowHint(RzMemo2.ClientToScreen(pt));

  end;

end;

procedure TForm3.RzButton2Click(Sender: TObject);

begin

  RxRichEdit1.Clear;

end;

procedure TForm3.RzButton3Click(Sender: TObject);

var

  pt:TPoint;

  buf:TDataPack;

  Bbyte:TIdBytes;

begin

  if RzButton3.Caption = '锁定' then

  begin

    FillChar(buf, SizeOf(TDataPack), '');

    buf.Command := CltLockSrc;

    StrCopy(@buf.CltInfo.CltName, PChar(Encrystrings(form3.RzEdit2.Text)));

    BByte := RawToBytes(buf, SizeOf(TDataPack));

    try

      try

        IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

      except

        //

      end;

    finally

      RxRichEdit1.Visible := False;

      RzMemo2.Visible := False;

      RzListBox1.Visible := False;

      RzToolButton1.Visible := False;

      RzButton4.Visible := False;

      RzButton2.Visible := False;

      RzCheckBox1.Visible := False;

      RzLabel5.Visible := False;

      RzEdit3.Visible := False;

      RzTrayIcon1.MinimizeApp;

      RzButton3.Caption :='解锁';

      LabeledEdit1.Visible := True;

      RzLabel1.Visible := False;

      RzLabel2.Visible := False;

      RzEdit1.Visible := False;

      RzEdit2.Visible := False;

      RzPanel3.Visible := False;

      LabeledEdit1.SetFocus;

      LockStatus :=True;     //屏幕锁定状态

      ScrollBox1.Visible := False;

    end;

//    except

//      RzButton3.CustomHint.Title :='错误';

//      RzButton3.CustomHint.Description :='锁屏失败，请重试';

//      pt.X :=RzButton3.Width div 2;

//      pt.Y :=RzButton3.Height div 2;

//      RzButton3.CustomHint.ImageIndex :=1;

//      RzButton3.CustomHint.HideAfter :=3000;

//      RzButton3.CustomHint.ShowHint(RzButton3.ClientToScreen(pt));

//    end;

  end else begin

      if LabeledEdit1.Text = UnLockString then

      begin

        FillChar(buf, SizeOf(TDataPack), '');

        buf.Command := CltUnlockSrc;

        StrCopy(@buf.CltInfo.CltName, PChar(Encrystrings(form3.RzEdit2.Text)));

        BByte := RawToBytes(buf, SizeOf(TDataPack));

        try

          try

            IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

          except

            //

          end;

        finally

          UnLcokTimes :=0;

          RxRichEdit1.Visible := True ;

          RzMemo2.Visible := True ;

          RzListBox1.Visible := True ;

          RzToolButton1.Visible := True ;

          RzButton4.Visible := True;

          RzButton2.Visible := True ;

          RzCheckBox1.Visible := True;

          RzPanel3.Visible := True;

          RzButton3.Caption :='锁定';

          LabeledEdit1.Text :='';

          LabeledEdit1.Visible := False;

          if not RzCheckBox1.Checked  then

          begin

            RzLabel5.Visible := True;

            RzEdit3.Visible := True;

            RzLabel1.Visible := True;

            RzLabel2.Visible := True;

            RzEdit1.Visible := True;

            RzEdit2.Visible := True;

            RzPanel3.Visible := False;

          end;

          LockStatus := False;   //屏幕锁定状态

//          RzButton3.CustomHint.Title :='错误';

//          RzButton3.CustomHint.Description :='解锁失败，请重试';

//          pt.X :=RzButton3.Width div 2;

//          pt.Y :=RzButton3.Height div 2;

//          RzButton3.CustomHint.ImageIndex :=1;

//          RzButton3.CustomHint.HideAfter :=3000;

//          RzButton3.CustomHint.ShowHint(RzButton3.ClientToScreen(pt));

        end;

      end else begin

        UnLcokTimes := UnLcokTimes+1;

        LabeledEdit1.Text :='';

        LabeledEdit1.CustomHint.Title :='错误';

        LabeledEdit1.CustomHint.Description :='解锁密码不正确';

        pt.X :=LabeledEdit1.Width div 2;

        pt.Y :=LabeledEdit1.Height div 2;

        LabeledEdit1.CustomHint.ImageIndex :=0;

        LabeledEdit1.CustomHint.HideAfter :=2000;

        LabeledEdit1.CustomHint.ShowHint(LabeledEdit1.ClientToScreen(pt));

        LabeledEdit1.SetFocus;

        if UnLcokTimes >=3 then

        begin

          ShowMessage('解锁密码尝试3次均不正确，程序退出');

          if IdTCPClient1.Connected  then  IdTCPClient1.Disconnect;

          if Assigned(RevDataThread ) then RevDataThread.Terminate;

          Close;

        end;

      end;

  end;

end;

procedure TForm3.RzButton4Click(Sender: TObject);

var

  buf:TDataPack;

  Bbyte:TIdBytes;

  s:string;

  pt:TPoint;

begin

  if RzListBox1.ItemIndex <>-1 then

  begin

    FillChar(buf, SizeOf(TDataPack), '');

    s:=RzListBox1.SelectedItem;

    StrCopy(@buf.CltInfo.CltName, PChar(Encrystrings(form3.RzEdit2.Text)));

    StrCopy(@buf.DstInfo.CltName, PChar(Encrystrings(s)));

    buf.Command :=CltClear;

    BByte := RawToBytes(buf, SizeOf(TDataPack));

    try

      IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

      RxRichEdit1.CustomHint.Title :='提示';

      RxRichEdit1.CustomHint.Description :='您已清除自己和对方聊天记录';

      pt.X :=RxRichEdit1.Width div 2;

      pt.Y :=RxRichEdit1.Height div 2;

      RxRichEdit1.CustomHint.ImageIndex :=1;

      RxRichEdit1.CustomHint.HideAfter :=8000;

      RxRichEdit1.CustomHint.ShowHint(RxRichEdit1.ClientToScreen(pt));

      RxRichEdit1.Clear;

    except

      ShowMessage('已与服务器断开连接,清除屏幕不成功');

      RzListBox1.Items.Clear;

      RzEdit2.ReadOnly := False;

      RzToolButton1.Enabled := False;

      RzButton4.Enabled := False;

      RzCheckBox1.Checked := False;

    end;

  end else begin

      RzListBox1.CustomHint.Title :='提示';

      RzListBox1.CustomHint.Description :='请在这里选择一个清除屏幕对象';

      pt.X :=RzListBox1.Width div 2;

      pt.Y :=RzListBox1.Height div 6;

      RzListBox1.CustomHint.ImageIndex :=1;

      RzListBox1.CustomHint.HideAfter :=3000;

      RzListBox1.CustomHint.ShowHint(RzListBox1.ClientToScreen(pt));

  end;

end;

procedure TForm3.RzButton5Click(Sender: TObject);

begin

  Application.Terminate;

end;

procedure TForm3.RzCheckBox1Click(Sender: TObject);

var

  pt:TPoint;

begin

  IdTCPClient1.Host := RzEdit1.Text;

  if RzEdit3.Text <>'' then IdTCPClient1.Port := StrToInt(RzEdit3.Text)

  else begin

    RzEdit3.CustomHint.Title :='提示';

    RzEdit3.CustomHint.Description :='服务器端口不能为空';

    pt.X :=RzEdit3.Width div 2;

    pt.Y :=RzEdit3.Height div 2;

    RzEdit3.CustomHint.ImageIndex :=0;

    RzEdit3.CustomHint.HideAfter :=2000;

    RzEdit3.CustomHint.ShowHint(RzEdit3.ClientToScreen(pt));

    RzCheckBox1.Checked := False;

    Exit;

  end;

  if (RzEdit2.Text ='') then

  begin

    RzEdit2.CustomHint.Title :='提示';

    RzEdit2.CustomHint.Description :='聊天昵称不能为空';

    pt.X :=RzEdit2.Width div 2;

    pt.Y :=RzEdit2.Height div 2;

    RzEdit2.CustomHint.ImageIndex :=0;

    RzEdit2.CustomHint.HideAfter :=2000;

    RzEdit2.CustomHint.ShowHint(RzEdit2.ClientToScreen(pt));

    RzCheckBox1.Checked := False;

    Exit;

  end;

  if Pos(' ',RzEdit2.Text)<>0 then

  begin

    RzEdit2.CustomHint.Title :='提示';

    RzEdit2.CustomHint.Description :='聊天昵称中不能包含空格和 | 字符';

    pt.X :=RzEdit2.Width div 2;

    pt.Y :=RzEdit2.Height div 2;

    RzEdit2.CustomHint.ImageIndex :=0;

    RzEdit2.CustomHint.HideAfter :=2000;

    RzEdit2.CustomHint.ShowHint(RzEdit2.ClientToScreen(pt));

    RzCheckBox1.Checked := False;

    Exit;

  end;

  if (RzEdit1.Text ='') then

  begin

    RzEdit1.CustomHint.Title :='提示';

    RzEdit1.CustomHint.Description :='服务器地址不能为空';

    pt.X :=RzEdit1.Width div 2;

    pt.Y :=RzEdit1.Height div 2;

    RzEdit1.CustomHint.ImageIndex :=0;

    RzEdit1.CustomHint.HideAfter :=2000;

    RzEdit1.CustomHint.ShowHint(RzEdit1.ClientToScreen(pt));

    RzCheckBox1.Checked := False;

    Exit;

  end;

  try

    if  RzCheckBox1.Checked  then

    begin

      IdTCPClient1.Connect;

      RevDataThread := TRevDataThread.Create(True);

      RevDataThread.FreeOnTerminate := True;

      RevDataThread.Start;

      RzToolButton1.Enabled := True;

      RzButton4.Enabled := True;

      RzCheckBox1.Checked := True;

      RzEdit2.ReadOnly := True;

      Timer2.Enabled := True;

      RzEdit3.Visible := False;

      RzLabel5.Visible := False;

      RzLabel1.Visible := False;

      RzLabel2.Visible := False;

      RzPanel3.Visible := True;

      RzEdit1.Visible := False;

      RzEdit2.Visible := False;

      RzAnimator1.Animate := True;

    end

    else

    begin

      IdTCPClient1.Disconnect;

      if Assigned(RevDataThread)  then  RevDataThread.Terminate;

      RzCheckBox1.Checked := False;

      RzToolButton1.Enabled :=False;

      RzButton4.Enabled := False;

      RzEdit2.ReadOnly := False;

      Timer2.Enabled := False;

      RzEdit3.Visible := True;

      RzLabel5.Visible := True;

      RzLabel1.Visible := True;

      RzLabel2.Visible := True;

      RzPanel3.Visible := False;

      RzEdit1.Visible := True;

      RzEdit2.Visible := True;

      RzAnimator1.Animate := False;

      RzAnimator1.ImageIndex :=1;

    end;

  except

    RzEdit2.ReadOnly := False;

    RzCheckBox1.Checked := False;

    RzToolButton1.Enabled :=False;

    RzButton4.Enabled := False;

    if Assigned(RevDataThread)  then  RevDataThread.Terminate;

    if IdTCPClient1.Connected then IdTCPClient1.Disconnect;

    ShowMessage('连接服务器失败，请确认服务器地址是否正确');

  end;

end;

procedure TForm3.RzEdit1KeyPress(Sender: TObject; var Key: Char);

var

  tmp: string;

begin

  tmp := '0123456789.' + Char(VK_BACK) + Char(VK_DELETE);

  if Pos(Key, tmp) = 0 then Key := #0;

end;

procedure TForm3.RzEdit3KeyPress(Sender: TObject; var Key: Char);

var

  tmp: string;

begin

  tmp := '0123456789' + Char(VK_BACK) + Char(VK_DELETE);

  if Pos(Key, tmp) = 0 then Key := #0;

end;

procedure TForm3.RzListBox1DblClick(Sender: TObject);

begin

//  form1.Show;

end;

procedure TForm3.RzListBox1MouseEnter(Sender: TObject);

begin

  if RzTrayIcon1.Animate  then

  begin

    RzTrayIcon1.Animate := False;

    RzTrayIcon1.IconIndex := 0;

  end;

end;

procedure TForm3.RzMemo2KeyPress(Sender: TObject; var Key: Char);

begin

  if (Key = #13)   then

  begin

    if (((hi(GetKeyState(VK_CONTROL))) and $80) <> $80) and n2.Checked then

    begin

      Key :=#0;

      if RzToolButton1.Enabled  then RzToolButton1.Click;

    end;

  end;

end;

procedure TForm3.RzMemo2MouseEnter(Sender: TObject);

begin

  if RzTrayIcon1.Animate  then

  begin

    RzTrayIcon1.Animate := False;

    RzTrayIcon1.IconIndex := 0;

  end;

end;

procedure TForm3.RzSpinButtons1DownLeftClick(Sender: TObject);

begin

  if RzPanel3.Height > 40 then  RzPanel3.Height := (RzPanel3.Height -4) div 3;

end;

procedure TForm3.RzSpinButtons1UpRightClick(Sender: TObject);

begin

  if RzPanel3.Height <40 then RzPanel3.Height := RzPanel3.Height *3 +4;

end;

procedure TForm3.RzTrayIcon1MinimizeApp(Sender: TObject);

begin

  BoolEnable:= True;

end;

procedure TForm3.RzTrayIcon1RestoreApp(Sender: TObject);

begin

  BoolEnable:= False;

  RzTrayIcon1.Animate:= False;

  RzTrayIcon1.IconIndex := 0;

end;

procedure TForm3.SetBarHeight;

var

  AppBarData: TAPPBARDATA;

begin

  AppBarData.cbSize := SizeOf(AppBarData);

  If SHAppBarMessage(ABM_GETSTATE, AppBarData) AND (ABS_AUTOHIDE) <> 0 then

  begin

    Cur_Top := 1;

    Cur_Bottom := Screen.Height - 1;

  end

  else

  begin

    SHAppBarMessage(ABM_GETTASKBARPOS, AppBarData);

    case AppBarData.uEdge of

      ABE_TOP:

        begin

          Cur_Top := AppBarData.rc.Bottom + 1;

          Cur_Bottom := Screen.Height - 1;

        end;

      ABE_LEFT:

        begin

          Cur_Top := 1;

          Cur_Bottom := Screen.Height - 1;

        end;

      ABE_RIGHT:

        begin

          Cur_Top := 1;

          Cur_Bottom := Screen.Height - 1;

        end;

      ABE_BOTTOM:

        begin

          Cur_Top := 1;

          Cur_Bottom := Screen.Height -

            (AppBarData.rc.Bottom - AppBarData.rc.top) - 1;

        end;

    end;

  end;

end;

procedure TForm3.wmsizing(var Msg: TMessage);

begin

  inherited;

  if (akRight in FAnchors) then

  begin

    with PRect(Msg.LParam)^ do

    begin

      Left := Screen.Width - Width;

      top := Cur_Top;

      Right := Screen.Width;

      Bottom := Cur_Bottom

    end;

  end

  else if (akLeft in FAnchors) then

  begin

    with PRect(Msg.LParam)^ do

    begin

      Left := 0;

      top := Cur_Top;

      Right := Width;

      Bottom := Cur_Bottom;

    end;

  end;

end;

{ TRevDataThread }

procedure TRevDataThread.AddCltList;

var

  t,s:string;

  List:TStringList;

  OldCount,NewCount:Integer;

begin

  list:= TStringList.Create;

  OldCount := Form3.RzListBox1.Count;

  Form3.RzListBox1.Clear;

  t:= string(buf.Data);

//  count:=0;                     // dak|dkej|dinna|

//  for i:= 0 to strlen(pchar(s)) do if copy(s,i,1)='|' then count:=count+1;  //计算字符串中包含几个分隔符 |

//  for I := 0 to Count do

//  begin

//    ss:= LeftStr(s,Pos('|',s)-1);

//  end;

  s:= Uncrystrings(t);

  s:=LeftStr(s,StrLen(PChar(s))-1);

  List.Delimiter:='|';

  List.DelimitedText:=s;

  //Form3.RzTrayIcon1.Hint := List.Text;

  Form3.RzListBox1.Items.Assign(list);

  NewCount := form3.RzListBox1.Count;

  List.Free;

  if NewCount > OldCount  then form3.RzTrayIcon1.ShowBalloonHint('提示','有用户登录',bhiInfo,10)

  else if NewCount < OldCount then form3.RzTrayIcon1.ShowBalloonHint('提示','有用户下线',bhiInfo,10);

end;

procedure TRevDataThread.AddMessage;

var

  ss:string;

begin

  ss:= DecryStr(UncrypKey(string(buf.CltInfo.CltName),TKey),mkey);

  case buf.Command  of

    CltLockSrc: Form3.RxRichEdit1.Lines.Add(ss + ' 锁定了屏幕');

    CltUnlockSrc : Form3.RxRichEdit1.Lines.Add(ss + ' 解锁了屏幕');

  end;

  PostMessage(Form3.RxRichEdit1.Handle, WM_VSCROLL, SB_BOTTOM, 0);

end;

procedure TRevDataThread.ClearScr;

var

  pt:TPoint;

  ss:string;

begin

  Form3.RxRichEdit1.Clear;

  ss:= Uncrystrings(string(buf.CltInfo.CltName));

  Form3.RxRichEdit1.CustomHint.Title :='提示';

  Form3.RxRichEdit1.CustomHint.Description := ss+' 清除了您的聊天记录';

  pt.X :=Form3.RxRichEdit1.Width div 2;

  pt.Y :=Form3.RxRichEdit1.Height div 2;

  Form3.RxRichEdit1.CustomHint.ImageIndex :=1;

  Form3.RxRichEdit1.CustomHint.HideAfter :=8000;

  Form3.RxRichEdit1.CustomHint.ShowHint(Form3.RxRichEdit1.ClientToScreen(pt));

  Form3.RxRichEdit1.Clear;

  Form3.RxRichEdit1.Lines.Add(ss+' 清除了您的聊天记录');

end;

procedure TRevDataThread.CltMessageIn;

var

  s:string;

begin

  s:= Uncrystrings(string(buf.CltInfo.CltName));

  form3.RxRichEdit1.Lines.Add(s + ' 可能离开，TA的屏幕是锁定状态') ;

  PostMessage(Form3.RxRichEdit1.Handle, WM_VSCROLL, SB_BOTTOM, 0);

end;

procedure TRevDataThread.DoDiscnt;

begin

  form3.RzCheckBox1.Checked := False;

  Form3.IdTCPClient1.Disconnect;

  ShowMessage(Form3.RzEdit2.Text +' 已经存在，请更名重新登录');

end;

procedure TRevDataThread.DoSrvCloseQuery;

begin

  Form3.IdTCPClient1.Disconnect;

  Form3.RzCheckBox1.Checked := False;

end;

procedure TRevDataThread.DoSrvMessage;

var

  nr,ds:string;

begin

  nr:=Uncrystrings(string(buf.Data));

  ds:= Uncrystrings(string(buf.DstInfo.CltName));

  Form3.RxRichEdit1.Lines.Add('[服务器消息]：您发送给 ['+ ds +'] 的消息： “'+ nr +'"，转发不成功，请重新发送');

  PostMessage(Form3.RxRichEdit1.Handle, WM_VSCROLL, SB_BOTTOM, 0);

end;

procedure TRevDataThread.Execute;

var

  BByte: TIdBytes;

  Nc:string;

begin

  inherited;

  FillChar(buf, SizeOf(TDataPack), '');

  buf.Command := CltConnect;

  Nc := Encrystrings(form3.RzEdit2.Text);

  StrCopy(@buf.CltInfo.CltName, PChar(Nc));

  BByte := RawToBytes(buf, SizeOf(TDataPack));

  Form3.IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

  while (not Terminated) and (Form3.IdTCPClient1.Connected) do

  begin

    FillChar(buf, SizeOf(TDataPack), '');

    Form3.IdTCPClient1.IOHandler.ReadBytes(BByte, SizeOf(TDataPack), False);

    BytesToRaw(BByte, buf, SizeOf(TDataPack));

    case buf.Command of

      CltSendMessage:

        begin

          //SendMessage(Handle,CustMsg,CltSendMessage,Integer(PDataPack(buf)));

          Synchronize(showmsg);

          if LockStatus  then

          begin

            buf.DstInfo.CltName := buf.CltInfo.CltName;

            buf.Command := CltMessage;

            StrCopy(@buf.CltInfo.CltName, PChar(Encrystrings(form3.RzEdit2.Text)));

            BByte := RawToBytes(buf, SizeOf(TDataPack));

            Form3.IdTCPClient1.IOHandler.Write(BByte, SizeOf(TDataPack));

          end;

        end;

      CltList :                   Synchronize(AddCltList);

      CltDisconnect :             Synchronize(DoDiscnt);

      CltTimer :  ;

      CltClear :                  Synchronize(clearscr);

      CltLockSrc,CltUnlockSrc  :  Synchronize(Addmessage);

      CltMessage :                Synchronize(cltmessageIn);

      SrvMessage :                Synchronize(DoSrvMessage);

      SrvCloseQuery :             Synchronize(DoSrvCloseQuery);

    end;

  end;

end;

procedure TRevDataThread.ShowMsg;

var

  s,ss,bm:string;

  ctl:TComponent;

begin

  s:=Uncrystrings(string(buf.Data));

  ss:= Uncrystrings(string(buf.CltInfo.CltName));

  if CheckBmp(s) then

  begin

    bm := Copy(s,2,2);

    Form3.RxRichEdit1.Lines.Add(ss + ' 对你说：');

    //Clipboard.Assign(form3.Image1.Picture);

    ctl:= Form3.FindComponent('Image'+bm);

    if ctl <> nil then

    begin

      Clipboard.Assign(TImage(ctl).Picture);

      form3.RxRichEdit1.PasteFromClipboard;

    end;

  end else Form3.RxRichEdit1.Lines.Add(ss + ' 对你说：'+s );

  PostMessage(Form3.RxRichEdit1.Handle, WM_VSCROLL, SB_BOTTOM, 0);

  if BoolEnable or ((form3.Timer1.Enabled) and (not form3.MousePosion))  then

  begin

    if not Form3.RzTrayIcon1.Animate then Form3.RzTrayIcon1.Animate:=True;

  end;

end;

end.

　　公共单元

unit Unit2;

interface

uses Windows,Messages,Classes,SysUtils,StrUtils;

 const CustMsg = WM_USER + 2110;

       CltConnect = 1;

       CltDisconnect =2;

       CltSendMessage =3;

       CltList=4;

       CltTimer =5;

       CltClear = 6;

       CltLockSrc =7;

       CltUnlockSrc = 8;

       CltMessage    = 9;

       SrvMessage  =10;

       SrvTimer =11;

       SrvCloseQuery =12;

       DataSize = 1024 *5;     //数据缓冲区大小

       UnLockString = '123456';

 type

  TCltInfo = packed record

    CltIP:array[0..14] of Char;

    CltName:array[0..255] of Char;

  end;

  TDataPack = record

    CltInfo:TCltInfo;

    DstInfo:TCltInfo;

    Command:Integer;

    Data:array[0..DataSize -1] of Char;

  end;

  PDataPack = ^TDataPack;

function Encrystrings(str:string):string;

function Uncrystrings(str:string):string;

function EncrypKey(Src: String; Key: String): string;

function UncrypKey(Src: String; Key: String): string;

function GetTMkey:string;

function CheckBmp(Str:string):Boolean;

var

  UnLcokTimes:Integer;

  LockStatus:Boolean;

implementation

  uses Unit4;

function CheckBmp(Str:string):Boolean;

begin

  Result := False;

  if Length(Str) < 4 then  Exit;

  if (LeftStr(Str,1) ='[') and (Copy(Str,4,1) = ']') then Result :=True;

end;

function Encrystrings(str:string):string;

var

  tmp:string;

begin

  tmp := EncryStr(str,MKey);

  Result := EncrypKey(tmp,TKey);

end;

function Uncrystrings(str:string):string;

var

  tmp:string;

begin

  tmp:= UncrypKey(str,TKey);

  Result := DecryStr(tmp,MKey);

end;

// 加密函数

function EncrypKey(Src: String; Key: String): string;

var

  KeyLen: integer;

  KeyPos: integer;

  offset: integer;

  dest: string;

  SrcPos: integer;

  SrcAsc: integer;

  Range: integer;

begin

  //此处省略，自己写

end;

// 解密函数

function UncrypKey(Src: String; Key: String): string;

var

  //idx: integer;

  KeyLen: integer;

  KeyPos: integer;

  offset: integer;

  dest: string;

  SrcPos: integer;

  SrcAsc: integer;

  TmpSrcAsc: integer;

begin

 //此处省略，自己写

end;

function GetTMkey:string;

var

  ss: string;

  n: Integer;

begin

  ss := '';

  Randomize;

  repeat

    n := Random(127);

    if n>=34 then ss := ss + char(n);

  until (Length(ss)>=12);

  Result  := ss;

end;

end.

Indy10 即时通讯Demo的更多相关文章

利用WCF双工模式实现即时通讯
概述 WCF陆陆续续也用过多次,但每次都是浅尝辄止,以将够解决问题为王道,这几天稍闲,特寻了些资料看,昨晚尝试使用WCF的双工模式实现了一个简单的即时通讯程序,通过服务端转发实现客户端之间的通讯.这只 ...
【原创】轻量级即时通讯技术MobileIMSDK：Android客户端开发指南
申明:MobileIMSDK 目前为个人维护的原创开源工程,现陆续整理了一些资料,希望对需要的人有用.如需与作者交流,见文章底签名处,互相学习. MobileIMSDK开源工程的代码托管地址请进入 G ...
【原创】轻量级移动端即时通讯技术 MobileIMSDK 发布了
申明:MobileIMSDK目前为个人原创开源工程,投入了大量的时间和精力,希望对需要的人有所帮助.如需与作者交流,见文章底部个人签名处,互相学习.Q群:215891622,欢迎共同志趣者学习和交流. ...
ActiveMQ 即时通讯服务浅析
一. 概述与介绍 ActiveMQ 是Apache出品,最流行的.功能强大的即时通讯和集成模式的开源服务器.ActiveMQ 是一个完全支持JMS1.1和J2EE 1.4规范的 JMS Provi ...
iOS 即时通讯SDK的集成，快速搭建自己的聊天系统
现在的外包项目需求变态的各种各样,今天要做社交,明天要加电商,后天又要加直播了,这些系统如果要自己开发,除非大公司技术和人力都够,不然短时间是几乎实现不了的.所以学会灵活利用市面上的各种SDK是灰常重 ...
即时通讯（IM-instant messager）
即时通讯又叫实时通讯,简单来说就是两个及以上的人使用网络进行文字.文件.语音和视频的交流. 首先,进行网络进行通信,肯定需要网络协议,即时通讯专用的协议就是xmpp.xmpp协议要传递的消息类型是xm ...
ActiveMQ 即时通讯服务——浅析
一. 概述与介绍 ActiveMQ 是Apache出品,最流行的.功能强大的即时通讯和集成模式的开源服务器.ActiveMQ 是一个完全支持JMS1.1和J2EE 1.4规范的 JMS Provide ...
用smack+openfire做即时通讯
首发:个人博客必须说明:smack最新的4.1.1,相对之前版本变化很大,而且资料缺乏,官方文档也不好,所以还是用老版本3.2.2吧.这篇博文中的代码是4.1.1版的,但不推荐用它.用openfir ...
XMPP即时通讯
XMPP:XMPP是基于XML的点对点通讯协议,The Extensible Messaging and Presence Protocol(可扩展通讯和表示协议). XMPP可用于服务类实时通讯,表 ...

随机推荐

Intel 英特尔
英特尔英特尔基本资料公司名称:英特尔(集成电路公司) 外文名称:Intel Corporation(Integrated Electronics Corporation) 总部地 ...
在网页中在线浏览ppt文档
方法一: 把ppt文件的扩展名直接修改为pps,嵌入到网页中缺点:这种方式浏览器会提示是打开,还是下载,选择打开的话会直接在浏览器中打开,并且客户端一定要安装Office PowerPoint才能打 ...
jsp 常用9大内置对象
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ...
paip.gch预编译头不生效的原因以及解决:
paip.gch预编译头不生效的原因以及解决: 作者Attilax , EMAIL:1466519819@qq.com 来源:attilax的专栏地址:http://blog.csdn.net/a ...
CCDictionary&CCArray执行retain()重要点
CCDictionary也需要执行retain(),否则则跟CCArray,返回则释放对象. 在Lua中,忘记了retain(),导致一些出现gCCDictionary:objectForKey(ke ...
自定义绘制View
Paint(画笔) Canvas(画布) The Canvas class holds the "draw" calls. To draw s ...
Android - Ashmem驱动
以下资料摘录整理自老罗的Android之旅博客,是对老罗的博客关于Android底层原理的一个抽象的知识概括总结(如有错误欢迎指出)(侵删):http://blog.csdn.net/luosheng ...
常用PC服务器LSI阵列卡配置
通常,我们使用的DELL/HP/IBM三家的机架式PC级服务器阵列卡是从LSI的卡OEM出来的,DELL和IBM两家的阵列卡原生程度较高,没有做太多封装,可以用原厂提供的阵列卡管理工具进行监控:而HP ...
HDU 5139 Formula 卡内存
题目就是求这个 n达到10^7,测试数据组数为10^5 为了防止TLE,一开始把每个n对应的值先求出来,但发现竟然开不了10^7的数组(MLE),然后就意识到这是第一道卡内存的题目... 只能离线做, ...
hdu 2189
//hdu2189 题意大概就是给n个人,分成多组,要求每组人数都是素数,求有多少种... 解法就是先把150以内的素数全部存入一个数组,然后利用a[j+b[i]]+=a[j];这道题一开始没理解 ...

Indy10 即时通讯Demo

Indy10 即时通讯Demo的更多相关文章

随机推荐

热门专题