• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

Delphi学习笔记Indy10

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

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

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

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

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.

　　

　　

鲜花
握手
雷人
路过
鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
Matlab 编程简介与实例发布时间：2022-07-18
下一篇：
第2章 MATLAB面向对象编程入门——源自《MATLAB面向对象编程-从入门到设计模式》 ...发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap