|
Вопрос # 5 225/ вопрос открыт / |
|
Здравствуйте, уважаемые эксперты!
Помогите переделать этот консольный сервер под форму, чтобы запускать/останавливать сервер по нажатию кнопки на форме , от не знания мучаюсь уже два дня бестолку, заранее благодарен;
Приложение: Переключить в обычный режим- program RemoteControlServer;
- {$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.
 |
Вопрос задал: DimonZ (статус: Посетитель)
Вопрос отправлен: 24 апреля 2011, 15:14
Состояние вопроса: открыт, ответов: 0.
|
Мини-форум вопроса
Всего сообщений: 3; последнее сообщение — 27 апреля 2011, 05:23; участников в обсуждении: 2.
|
Егор (статус: 10-ый класс), 24 апреля 2011, 16:43 [#1]:
а в чём проблема-то? что именно не получается?
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
|
|
|
DimonZ (статус: Посетитель), 24 апреля 2011, 23:09 [#2]:
Проблема в том что я не силен с работой с сокетами в потоках.
|
|
|
Егор (статус: 10-ый класс), 27 апреля 2011, 05:23 [#3]:
так код же есть? что мешает его оформить в отдельный модуль (unit)?
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
