Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2008.12.14;
Скачать: [xml.tar.bz2];

Вниз

Получение изображения рабочего стола   Найти похожие ветки 

 
Olegz77 ©   (2008-02-05 16:44) [0]

У меня такой вопрос. Хочу сделать прогу для удаленного администрирования (типа Radmin, только для внутреннего пользования в малой сети), надо научиться получать изображение рабочего стола удаленного компьютера. Знаю, что с помощью GetDC(0) можно получить хэндл окна десктопа, но когда удаленный компьютер залочен, это не проходит. Что делать?


 
clickmaker ©   (2008-02-05 17:10) [1]

Radmin использует драйвер видеозахвата, а не GetDC


 
Pir   (2008-02-05 19:03) [2]

плюс с GetDC нельзя получить хэндл окна, только идентификатор контекста устройства


 
Dmitry S ©   (2008-02-05 20:24) [3]

Еще Layered Windows (это те которые полупрозрачные) не попадут в GetDC(0)


 
slow!alfamoon!com   (2008-02-06 12:15) [4]

Когда комп залочен, активный десктоп - не winsta0/default, а другой.


 
Slym ©   (2008-02-06 12:50) [5]

Olegz77 ©   (05.02.08 16:44)
у меня складывается впечатление что на любой сетевой вопрос у меня уже есть пример :)

program NetScreenServerCon;
{$apptype console}

uses
 Windows,SysUtils,Classes,ScktComp,Graphics,Jpeg;

type
 TSCThread=class(TServerClientThread)
 protected
   procedure GrabScreen(Stream:TStream;const ImgSize:TPoint);
   procedure ClientExecute; override;
 end;

procedure TSCThread.GrabScreen(Stream:TStream;const ImgSize:TPoint);
var
 Desktop:HWnd;
 DesktopRect: TRect;
 DesktopDC:HDc;
 Bitmap:TBitmap;
 Jpeg:TJpegImage;
begin
 Stream.Size:=0;
 Bitmap:=TBitmap.Create;
 try
   Desktop:=GetDesktopWindow;
   GetWindowRect(Desktop,DesktopRect);
   Bitmap.Height:=ImgSize.Y;
   Bitmap.Width:=ImgSize.X;
   DesktopDC:=GetWindowDC(Desktop);
   try
     Win32Check(StretchBlt(Bitmap.Canvas.Handle,0,0,Bitmap.Width,Bitmap.Height,
               DesktopDC,DesktopRect.Left,DesktopRect.Top,DesktopRect.Right,DesktopRect.Bottom, SRCCOPY));
   finally
     ReleaseDC(Desktop,DesktopDC);
   end;
   Jpeg:=TJpegImage.Create;
   try
     Jpeg.Assign(Bitmap);
     Jpeg.SaveToStream(Stream);
   finally
     Jpeg.Free;
   end;
 finally
   Bitmap.Free;
 end;
end;

procedure TSCThread.ClientExecute;
var
 ScreenStream:TMemoryStream;
 Buf:array[0..1023] of byte;
 ImgSize:TPoint;
 size:integer;
begin
 while (not Terminated) and ClientSocket.Connected do
 try
   ScreenStream:=TMemoryStream.Create;
   try
     if ClientSocket.ReceiveBuf(ImgSize,SizeOf(ImgSize))<>SizeOf(ImgSize) then exit;
     GrabScreen(ScreenStream,ImgSize);
     ScreenStream.Position:=0;
     size:=ScreenStream.Size;
     ClientSocket.SendBuf(size,SizeOf(size));
     while ScreenStream.Position<ScreenStream.Size do
     begin
       size:=ScreenStream.Read(Buf,SizeOf(Buf));
       if ClientSocket.SendBuf(Buf,size)<>size then exit;
     end;
   finally
     ScreenStream.Free;
   end;
 except
   Terminate;
   HandleException;
 end;
end;

function Proc2Method(Code,Data:pointer):TMethod;
begin
 result.Code:=Code;
 result.Data:=Data;
end;

procedure GetThread(self,Sender: TObject; ClientSocket: TServerClientWinSocket;
   var SocketThread: TServerClientThread);
begin
 SocketThread:=TSCThread.Create(true,ClientSocket);
 SocketThread.Priority:=tpLower;
 SocketThread.Resume;
end;

var Server:TServerSocket;
begin
 Server:=TServerSocket.Create(nil);
 try
   Server.ServerType:=stThreadBlocking;
   Server.OnGetThread:=TGetThreadEvent(Proc2Method(@GetThread,Server));
   Server.Port:=1234;
   Server.Active:=true;
   while Server.Active do Sleep(100);
 finally
   Server.Free;
 end;
end.


 
Slym ©   (2008-02-06 12:57) [6]

а это клиентская часть
unit ClientUnit;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Forms,
 ExtCtrls, StdCtrls, ScktComp, Controls;

type
 TClientThread=class(TThread)
 private
   ClientSocket: TClientSocket;
   LastUpdate:DWORD;
   Bitmap:TBitmap;
 protected
   procedure UpdateScreen;
   procedure Execute;override;
 public
   constructor Create(CreateSuspended: Boolean;const Address:string);
   destructor Destroy;override;
 end;

 TForm1 = class(TForm)
   Panel1: TPanel;
   AddressEd: TEdit;
   Button1: TButton;
   Image: TImage;
   procedure Button1Click(Sender: TObject);
 private
   ClientThread:TClientThread;
 public
 end;

var
 Form1: TForm1;

implementation
uses math,Jpeg;
{$R *.dfm}

{ TClientThread }

constructor TClientThread.Create(CreateSuspended: Boolean;const Address:string);
var i:integer;
begin
 Bitmap:=TBitmap.Create;
 ClientSocket:=TClientSocket.Create(nil);
 ClientSocket.ClientType:=ctBlocking;
 i:=pos(":",Address);
 ClientSocket.Address:=copy(Address,1,i-1);
 ClientSocket.Port:=StrToInt(copy(Address,i+1,MaxInt));
 ClientSocket.Active:=true;
 inherited Create(CreateSuspended);
end;

destructor TClientThread.Destroy;
begin
 ClientSocket.Free;
 Bitmap.Free;
 inherited;
end;

procedure TClientThread.Execute;
var
 Socket:TClientWinSocket;
 ScreenStream:TMemoryStream;
 ImgSize:TPoint;
 Buf:array[0..1023] of byte;
 size,ToRead:integer;
 Jpeg:TJpegImage;
begin
 Socket:=ClientSocket.Socket;
 try
   ScreenStream:=TMemoryStream.Create;
   try
     while Socket.Connected do
     begin
       ImgSize.X:=Form1.Image.Width;
       ImgSize.Y:=Form1.Image.Height;
       if Socket.SendBuf(ImgSize,SizeOf(ImgSize))<>SizeOf(ImgSize) then exit;
       if Socket.ReceiveBuf(size,SizeOf(size))<>4 then exit;
       if (Size<0) or (Size>maxInt-1) then exit;
       ScreenStream.Size:=Size;
       ScreenStream.Position:=0;
       ToRead:=ScreenStream.Size-ScreenStream.Position;
       ToRead:=Min(ToRead,Length(Buf));
       while (ToRead>0) and Socket.Connected do
       begin
         Size:=Socket.ReceiveBuf(Buf,ToRead);
         if Size<0 then exit;
         ScreenStream.WriteBuffer(Buf,Size);
         ToRead:=ScreenStream.Size-ScreenStream.Position;
         ToRead:=Min(ToRead,Length(Buf));
       end;
       ScreenStream.Position:=0;
       Jpeg:=TJpegImage.Create;
       try
         Jpeg.LoadFromStream(ScreenStream);
         Bitmap.Assign(Jpeg);
       finally
         Jpeg.Free;
       end;
       Synchronize(UpdateScreen);
     end;
   finally
     ScreenStream.Free;
   end;
 finally
   Socket.Close;
 end;
end;

procedure TClientThread.UpdateScreen;
var tick:DWORD;
begin
 Form1.Image.Picture.Bitmap.Assign(Bitmap);
 tick:=GetTickCount;
 Form1.Image.Canvas.Brush.Style:=bsClear;
 Form1.Image.Canvas.TextOut(1,1,Format("Разрешение: %d:%d, cкорость: %f кадр/сек",[Bitmap.Width,Bitmap.Height,1000/(tick-LastUpdate)]));
 LastUpdate:=tick;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 ClientThread:=TClientThread.Create(true,AddressEd.Text);
 ClientThread.FreeOnTerminate:=true;
 ClientThread.Priority:=tpLower;
 ClientThread.Resume;
end;

end.


 
Olegz77 ©   (2008-02-06 13:27) [7]

Slim
Э-э-э, спасибо! Я прифигел. Беру время на переваривание.


 
Slym ©   (2008-02-06 14:24) [8]

Olegz77 ©   (06.02.08 13:27) [7]
это код приема/передачи картинки и только... и проблемы "удаленный компьютер залочен" не решает...



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2008.12.14;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.006 c
2-1225628386
programmer90
2008-11-02 15:19
2008.12.14
Запуск флеш-заставки вместо сплэш скрина


15-1223377264
desc
2008-10-07 15:01
2008.12.14
Автофигуры для MS Office


9-1176042275
Cerberus
2007-04-08 18:24
2008.12.14
Что лучше для создания 3д моделей Maya или 3D Max


4-1202232215
Dmitry S
2008-02-05 20:23
2008.12.14
"Прибить" повторный запуск моей проги.


2-1225974414
demon
2008-11-06 15:26
2008.12.14
Проблемы с отловом события WM_MBUTTONUP





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский