Indy10 即時通信Demo

時間 2019-12-07

標籤 indy10 indy 即時通信 demo 简体版

原文原文鏈接

最近閒來無事，從新學習了Indy10，順手寫了一段即時通信代碼。與上次寫的筆記有不一樣之處，但差異不大。windows

未研究過TCP打洞技術，因此下面的代碼採用的是客戶端--服務器--客戶端模式，也就是服務器端轉發消息的模式。服務器

客戶端模仿了QQ，能夠在屏幕四周停靠自動隱藏dom

本文也演示了在線程中操做VCL的兩張方法：ide

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.

1. iOS 即時通信demo（CFNetwork）
2. 阿里im即時通信 h5 demo
3. swoole實現IM即時通信demo
4. 小程序即時通信demo
5. iOS即時通信 - IM（即時通信）
6. 推送-即時推送-即時通信-在線Demo
7. 即時通信
8. socket 即時通信
9. iOS即時通信
10. iOS 即時通信
更多相關文章...
• SQL 通配符 - SQL 教程
• PHP 5 時區 - PHP參考手冊
• TiDB 在摩拜單車在線數據業務的應用和實踐
• RxJava操作符（九）Connectable Observable Operators

相關標籤/搜索

每日一句

每一个你不满意的现在，都有一个你没有努力的曾经。