Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.12.2010, 02:59   #1
Loadx
 
Регистрация: 03.12.2010
Сообщений: 8
По умолчанию Доработка функциональности клиент-сервер

Извините что беспокою по пустякам.
Возникла проблема.
Есть программа получающая изображение рабочего стола локальной машины с запущенным сервером.

Исходники:
СЕРВЕР

Код:

program NetScreenServerCon;
{$apptype console}

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

type
 TSCThread=class(TServerClientThread)
 private
   Bitmap:TBitmap;
   Jpeg:TJpegImage;
 protected
   procedure GrabScreen(Stream:TStream;const ImgSize:TPoint);
   procedure ClientExecute; override;
 public
   constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
   destructor Destroy; override;
 end;

constructor TSCThread.Create(CreateSuspended: Boolean;
 ASocket: TServerClientWinSocket);
begin
 Bitmap:=TBitmap.Create;
 Jpeg:=TJpegImage.Create;
 inherited;
end;

destructor TSCThread.Destroy;
begin
 Jpeg.Free;
 Bitmap.Free;
 inherited;
end;

procedure TSCThread.GrabScreen(Stream:TStream;const ImgSize:TPoint);
var
 Desktop:HWnd;
 DesktopRect: TRect;
 DesktopDC:HDc;
begin
 Stream.Size:=0;
 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.Assign(Bitmap);
 Jpeg.SaveToStream(Stream);
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.
Loadx вне форума Ответить с цитированием
Старый 03.12.2010, 03:00   #2
Loadx
 
Регистрация: 03.12.2010
Сообщений: 8
По умолчанию

КЛИЕНТ
Код:

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.


Вопрос состоит в том как расширить функциональность. А именно создать кнопку которая выполняла бы действие по типу "Socket.SendText('Hello');" а сервер в ответ отсылал любое другое текстовое сообщение. Причём можно было бы опять возобновить просмотр рабочего стола.
Loadx вне форума Ответить с цитированием
Старый 03.12.2010, 10:34   #3
s.Creator
Форумчанин
 
Регистрация: 28.09.2008
Сообщений: 344
По умолчанию

На сервере перед
Код:
if ClientSocket.ReceiveBuf(ImgSize,SizeOf(ImgSize))<>SizeOf(ImgSize) then exit;
написать
Код:
if ClientSocket.ReceiveBuf(WhatRead,SizeOf(WhatRead))<>SizeOf(WhatRead) then exit;
case WhatRead of // WhatRead: Integer;
   0: // отсылаем  изображение рабочего стола
   1: // закрываемся
   2: // ....
  end;
На клиенте используя методы сихронизации в нужный момент по событию посылаем не запрос на экран а чтото другое и соответственно это обрабатываем.
s.Creator вне форума Ответить с цитированием
Старый 03.12.2010, 12:12   #4
Loadx
 
Регистрация: 03.12.2010
Сообщений: 8
По умолчанию

А есть ли возможность определить ещё один сервер на другой порт.

Сервер 2 получилось создать, и к нему можно присоединиться, но не могу описать для него процедуру при приёме сообщения
Код:
procedure Server2ClientRead(Sender: TObject; Socket: TCustomWinSocket);
Может я не в ту часть кода сервера пихаю её?
Loadx вне форума Ответить с цитированием
Старый 03.12.2010, 18:22   #5
Loadx
 
Регистрация: 03.12.2010
Сообщений: 8
По умолчанию

s.Creator спасибо! Сделал по такому принципу.
Loadx вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как отправить видео захват(с веб-Кам.) Клиент->Сервер->Клиент RODNOC Мультимедиа в Delphi 17 03.10.2010 22:31
сервер+клиент+клиент на телефон Razyiller Работа с сетью в Delphi 3 01.04.2010 20:10
Возможно-ли Клиент-серверное приложение типа Клиент(Pascal) а сервер(CGI)? Demol Работа с сетью в Delphi 1 21.04.2009 16:18
Клиент-сервер-клиент Кронос Работа с сетью в Delphi 3 24.08.2007 07:57