unit_main.pas

dos example for create a profesional templeta

unit Unit_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, ExtCtrls,Unit_ScreenSpy,
  DXString, DXServerCore, XPMan;

type
  TConInfo = record
    isMouse:boolean;
    CmD:byte;
    x,y:Integer;  //坐标
  end;

  TForm_Main = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Button1: TButton;
    DXServerCore1: TDXServerCore;
    Timer1: TTimer;
    XPManifest1: TXPManifest;
    procedure Button1Click(Sender: TObject);
    procedure DXServerCore1NewConnect(ClientThread: TDXClientThread);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DXServerCore1ListenerStarted(Sender: TObject);
    procedure DXServerCore1ListenerFailed(ErrorCode: Integer);
    procedure DXServerCore1ListenerStopped(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    Screenimg:TScreenSpy;
    NowClient:TDXClientThread ;
    cansend:Boolean;
    { Public declarations }
  end;

var
  Form_Main: TForm_Main;
  FPoint:Tpoint;
  Tmpstream:TMemoryStream;
  moscon:TConInfo;

implementation
uses ZLIBEX;

{$R *.dfm}


procedure TForm_Main.Button1Click(Sender: TObject);
begin
if not DXServerCore1.IsActive  then
  begin
    DXServerCore1.ServerPort := SpinEdit1.Value ;
    DXServerCore1.Start ;
  end
else DXServerCore1.Stop ;
end;

procedure MyCompress(AStream: TStream );
var
  CompressionStream: TZCompressionStream;
  TmpStream :TMemoryStream ;
Begin
AStream.Position := 0;
try
  try
    TmpStream := TMemoryStream.Create ;
    TmpStream.LoadFromStream(AStream );
    AStream.Size := 0;
    CompressionStream := TZCompressionStream.Create(AStream,zcFastest );
    CompressionStream.CopyFrom(TmpStream, 0);
    AStream.Position := 0;
  finally
    TmpStream.Free ;
    CompressionStream.Free ;
  end;
except
end;
end;

procedure TForm_Main.DXServerCore1NewConnect(
  ClientThread: TDXClientThread);
var
  s:string;
  b:Char  ;
label
  ScreenTrans,ScreenContral,DisConnect;
begin
s := ClientThread.Socket.ReadLn(5000);
if s = 'Con' then goto ScreenContral
else goto ScreenTrans;

ScreenTrans:
  While ClientThread.Socket.Connected do
  begin
    try
      s := ClientThread.Socket.ReadLn(5000);
    except
    end;

    if s = 'BeginScreenTransfer' then              //准备传输
      begin
        Screenimg:= TScreenSpy.Create;
        Tmpstream := TMemoryStream.Create;
      end
    else if s = 'GetFirstScreen' then           //传输第一幅
      begin
        Screenimg.GetFirstBMP(Tmpstream);
        ClientThread.Socket.WriteLn('NextScreen');
        MyCompress(Tmpstream);
        ClientThread.Socket.SendFromStreamWithSize(Tmpstream);
        tmpstream.Clear ;
        Timer1.Enabled := True;
      end
    else if s = 'GetNextScreen' then       //传输下一幅
      begin
        cansend := True;
        NowClient := ClientThread;
      end
    else if s = 'StopScreenTransfer' then          //停止传输
      begin
        Timer1.Enabled := False ;
        Screenimg.Destroy;
        Tmpstream.Free;
      end
    else if s = 'SetPixels' then      //设置位图色深
      begin
     //   b :=
        b := ClientThread.Socket.Read ;
        Screenimg.PixelFormat := Byte(b);
      end;
  end;
  goto DisConnect;

ScreenContral:
  ClientThread.Socket.Disconnect ;
  While ClientThread.Socket.Connected do
  begin
    try
     // SetLength(Buf,0);
//      AContext.Connection.IOHandler.ReadBytes(Buf,SizeOf(TConInfo));
    except
      Exit;
    end;
    //if length(buf) < SizeOf(TConInfo) then  exit;
   // Move(buf[0],moscon,SizeOf(TConInfo));
    if moscon.isMouse  then    //鼠标动作
      begin
        FPoint := Point(moscon.X, moscon.Y);
        SetCursorPos(moscon.X, moscon.Y);
        case moscon.CmD of
        0:;//mousemove
        1:begin
           // SetCapture(WindowFromPoint(FPoint));
            mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
          end;
        2: begin
            //SetCapture(WindowFromPoint(FPoint));
            mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
           end;
        3: begin
           // SetCapture(WindowFromPoint(FPoint));
            mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
           end;
        4: begin
           // SetCapture(WindowFromPoint(FPoint));
            mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
           end;
        5: begin          //单击
          //  SetCapture(WindowFromPoint(FPoint));
            mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
            mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
           end;
        6: begin         //双击
          //  SetCapture(WindowFromPoint(FPoint));
            mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
            mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
            mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
            mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
           end;
        end;
      end
    else
      begin
        case moscon.CmD of
        0: begin
            keybd_event(91, 0, 0, 0);
            keybd_event(91, 0, KEYEVENTF_EXTENDEDKEY, 0);
            keybd_event(91, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
           end;
        1: begin
            keybd_event(VK_LCONTROL, 0, 0, 0);
            keybd_event(VK_LMENU, 0, 0, 0);
            keybd_event(VK_DELETE, 0, 0, 0);
            keybd_event(VK_DELETE, 0, KEYEVENTF_EXTENDEDKEY, 0);
            keybd_event(VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0);
            keybd_event(VK_LCONTROL, 0, KEYEVENTF_EXTENDEDKEY, 0);
            keybd_event(VK_DELETE, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
            keybd_event(VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
            keybd_event(VK_LCONTROL, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
           end;
        2: begin
            keybd_event(Byte(moscon.X), 0, 0, 0);
            keybd_event(Byte(moscon.X), 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
           end;
        end;
      end;
  end;

DisConnect:
//  if Assigned(Screenimg) then Screenimg.Free;
//  if Assigned(Tmpstream ) then Tmpstream.Free;
end;

procedure TForm_Main.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
 //  Form_Main.Hide;
   if DXServerCore1.IsActive  then
   begin
     DXServerCore1.Stop;
//     While DXServerCore1.ActiveNumberOfConnections>1 do Begin
//        DXString.DoSleepEx(1); // wait for clients to finished, then close!
//        Application.ProcessMessages; // because we are GUI
//     End;
   end;
   CanClose:=True;
end;

procedure TForm_Main.DXServerCore1ListenerStarted(Sender: TObject);
begin
ListBox1.Items.Add('Server has started,Binding:'+inttostr(SpinEdit1.Value)) ;
Button1.Caption := 'Stop';
end;

procedure TForm_Main.DXServerCore1ListenerFailed(ErrorCode: Integer);
begin
ListBox1.Items.Add('Server start Error!!');
Button1.Caption := 'Active';
end;

procedure TForm_Main.DXServerCore1ListenerStopped(Sender: TObject);
begin
Button1.Caption := 'Active';
ListBox1.Items.Add('Server has stoped!');
end;

procedure TForm_Main.FormCreate(Sender: TObject);
begin
  Button1Click(Self );
end;

procedure TForm_Main.Timer1Timer(Sender: TObject);
begin
  if cansend then
  begin
    cansend := False ;
    if NowClient = nil  then Exit;
    Screenimg.GetNextBMP(Tmpstream);
    if Tmpstream.Size > 1 then
    begin
      MyCompress(Tmpstream);
      NowClient.Socket.WriteLn('NextScreen');
//      Tmpstream.Position :=0;
      NowClient.Socket.SendFromStreamWithSize(Tmpstream);
      tmpstream.Clear ;
    end
    else
      NowClient.Socket.WriteLn('ScreenNotChange');
  end;

end;

end.