Indy10 即时通讯Demo

时间：2020-12-28 08:10:14

最近闲来无事，重新学习了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.

　　

　　

相关文章