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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.09.2015, 08:03   #1
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию Удаленное управление рабочим столом

Всем добрый день, написал клиента и сервера:
Клиент:
Код:
procedure TForm1.tcpTimerTimer(Sender: TObject);
var
  streamJpg: TMemoryStream;
  mouseCoord: TMouse;
begin
  tcpClient.IOHandler.WriteLn('connect');
  streamJpg:=TMemoryStream.Create;
  tcpClient.IOHandler.ReadStream(streamJpg);
  streamJpg.Position:=0;
  tcpClientImage.Picture.Bitmap.LoadFromStream(streamJpg);
  streamJpg.Clear;
  streamJpg.Free;
  //тут передача координат
  tcpClient.IOHandler.WriteLn('coord'+inttostr(mouseCoord.CursorPos.x)+'_'+inttostr(mouseCoord.CursorPos.y));
end;
Сервер:
Код:
procedure TForm1.tcpServerExecute(AContext: TIdContext);
var readConnect:string;
    streamServer: TMemoryStream;
    canvasServer: TCanvas;
    serverBitMap: TBitmap;
    ifCoord: string;
    i: Integer;
    sLeftCoord, sRigthCoord: String;
begin
  readConnect:=AContext.Connection.IOHandler.ReadLn;
    if readConnect='connect' then
      begin
        canvasServer:=TCanvas.Create;
        canvasServer.Handle:=GetDC(HWND_DESKTOP);
        serverBitMap:=TBitmap.Create;
        serverBitMap.Width:=Screen.Width;
        serverBitMap.Height:=Screen.Height;
        serverBitMap.Canvas.CopyRect(serverBitMap.Canvas.ClipRect, canvasServer, canvasServer.ClipRect);
        if not DrawIcon(serverBitMap.Canvas.Handle, Mouse.CursorPos.X, Mouse.CursorPos.Y, GetCursor) then
          begin
        end;
        streamServer:=TMemoryStream.Create;
        serverBitMap.SaveToStream(streamServer);
        AContext.Connection.IOHandler.Write(streamServer.Size);
        AContext.Connection.IOHandler.Write(streamServer);
        streamServer.Clear;
        streamServer.Free;
        serverBitMap.Free;
      end;
      if readConnect='hello' then
          begin
            ShowMessage('К вам кто то подключился! ггг');
      end;
      ifCoord := readConnect;
      Delete(ifCoord, 6, length(ifCoord)-5);
      if ifCoord='coord' then
        begin
          i := pos('_', readConnect);
          if i > 0 then
            begin
              sLeftCoord := copy(readConnect, 6, i - 6);
              sRigthCoord := copy(readConnect, i + 1, Length(readConnect) - i);
              SetCursorPos(StrToInt(sLeftCoord), StrToInt(sRigthCoord));
              form1.Caption:=  sLeftCoord;
            end;
      end;
end;
Но отклик у мышки неимоверный Я передвигаю мышью и на клиенте она передвигается только сек через 30 а то и больше . В чем беда? Отдельно все работает более менее сносно, то есть если отключить передачу скриншотов то мышка норм управляется и наоборот... Переделывал передачу курсора на mouse move тоже не помогло. Думаю где то подвисает соединение подскажите как исправить плз. Может нужно какие то другие методы использовать для передачи курсора ?
j0hnlem0n вне форума Ответить с цитированием
Старый 18.09.2015, 08:32   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
tcpTimerTimer
Это что за чудо? Обычный таймер?
Но зачем там мышку тулить? Передавай координаты в OnMouseMove.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 18.09.2015, 08:50   #3
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

Цитата:
Сообщение от Stilet Посмотреть сообщение
Это что за чудо? Обычный таймер?
Но зачем там мышку тулить? Передавай координаты в OnMouseMove.
Вот код с мышкой:
Код:
procedure TForm1.tcpClientImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    mouseCoord: TMouse;
begin
tcpClient.IOHandler.WriteLn('coord'+inttostr(mouseCoord.CursorPos.x)+'_'+inttostr(mouseCoord.CursorPos.y));
Form1.Caption:='coord'+inttostr(mouseCoord.CursorPos.x)+'_'+inttostr(mouseCoord.CursorPos.y);
end;
Да это обычный таймер, исправлял уже на OnMouseMove результат аналогичный (

Последний раз редактировалось j0hnlem0n; 18.09.2015 в 08:52.
j0hnlem0n вне форума Ответить с цитированием
Старый 18.09.2015, 11:44   #4
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

http://www.programmersforum.ru/showthread.php?t=242825
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 18.09.2015, 12:05   #5
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

А как кстати ты проверял движения мышки? Двинул и ждешь пока в капшине ответ от сервера не придет?
Я правильно понимаю, что ты по сети передаешь скрин всего экрана в его первозданном виде? который может весить мегабайта 2-5. Ты не думаешь, что у тебя тормоза именно из-за передачи самой картинки идут?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 18.09.2015, 13:48   #6
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

Хотелось бы самому разобраться в проблемах а не брать готовое и в чужом белье копаться.
Цитата:
Я правильно понимаю, что ты по сети передаешь скрин всего экрана в его первозданном виде? который может весить мегабайта 2-5. Ты не думаешь, что у тебя тормоза именно из-за передачи самой картинки идут?
Я понимаю что из за них будет тормоза да файл весит 3 метра. Сейчас как раз в jpeg хочу попробовать сжать но проблема не могу отобразить в TImage 'error #42' какая то вылазит. Проверял на виртуалке, запущена виртуалка и тут же прога, тыкаю мышкой на ярлык он становиться синим и тут же в экране проги он становится синим ). Мышка вообще быстро передвигается... Проверял так же двигал мышью в проге и навиртуалке смотрел отклик + в каптион у обеих окон значения синхронизировались норм.

Последний раз редактировалось j0hnlem0n; 18.09.2015 в 13:52.
j0hnlem0n вне форума Ответить с цитированием
Старый 18.09.2015, 14:47   #7
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
Сейчас как раз в jpeg хочу попробовать сжать
Это правильное решение, но тоже не даст скорости. Я делал передачу блоков экрана. Тогда сеть и проц не напрягались, но картинка теряла актуальность. А вообще тебе нужно Mirror Driver писать, если хочешь скорости. Или как ультраВНС делает - отлавливает хуком событие WM_PAINT и то, что отрисовывается отправляет наблюдателю (т.е. не весь экран и при необходимости)
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 18.09.2015, 16:57   #8
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

Спасибо, мне нужно сначала с простыми вещами разобраться ), а потом уже модернизировать.
j0hnlem0n вне форума Ответить с цитированием
Старый 18.09.2015, 17:59   #9
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Тогда жми в чпег и передавай либо блоками частями экран либо не сетуй на скорость отрисовки )
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.09.2015, 10:40   #10
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

Сделал так:
клиент:
Код:
procedure TForm1.tcpClientImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    mouseCoord: TMouse;
begin
tcpClient.IOHandler.WriteLn('coord'+inttostr(mouseCoord.CursorPos.x)+'_'+inttostr(mouseCoord.CursorPos.y));
//Form1.Caption:='coord'+inttostr(mouseCoord.CursorPos.x)+'_'+inttostr(mouseCoord.CursorPos.y);
end;

procedure TForm1.tcpTimerTimer(Sender: TObject);
var
  streamJpg: TMemoryStream;
  jpegImage: TJPEGImage;
begin
if tcpClient.Connected=true then
begin
 //tcpClient.IOHandler.WriteLn('connect');
  tcpClient.Socket.WriteLn('connect');
 streamJpg:=TMemoryStream.Create;
 //tcpClient.IOHandler.ReadStream(streamJpg);
 tcpClient.Socket.ReadStream(streamJpg);
 streamJpg.Position:=0;
 jpegImage := TJPEGImage.Create;
 jpegImage.LoadFromStream(streamJpg);
 //jpegImage.SaveToFile('1a.jpeg');
 tcpClientImage.Picture.Graphic:=jpegImage;
 jpegImage.Free;
 streamJpg.Clear;
 streamJpg.Free;
end
else
tcpClient.Connect();

end;
сервер:
Код:
procedure TForm1.tcpServerExecute(AContext: TIdContext);
var readConnect:string;
    streamServer: TMemoryStream;
    canvasServer: TCanvas;
    serverBitMap: TBitmap;
    jpgimg: TJPEGImage; //temp
    ifCoord: string;
    i: Integer;
    sLeftCoord, sRigthCoord: String;
    asd:TMemoryStream; //temp

begin
//  readConnect:=AContext.Connection.IOHandler.ReadLn;
  readConnect:=AContext.Connection.Socket.ReadLn;
  ifCoord := readConnect;
  Delete(ifCoord, 6, length(ifCoord)-5);
    if readConnect='connect' then
      begin
        canvasServer:=TCanvas.Create;
        canvasServer.Handle:=GetDC(HWND_DESKTOP);
        serverBitMap:=TBitmap.Create;
        serverBitMap.Width:=Screen.Width;
        serverBitMap.Height:=Screen.Height;
        serverBitMap.Canvas.CopyRect(serverBitMap.Canvas.ClipRect, canvasServer, canvasServer.ClipRect);
        if not DrawIcon(serverBitMap.Canvas.Handle, Mouse.CursorPos.X, Mouse.CursorPos.Y, GetCursor) then
          begin
        end;
        jpgimg:=TJPEGImage.Create;
        jpgimg.Assign(serverBitMap);
        jpgImg.CompressionQuality:=50;
        asd:=TMemoryStream.Create;
        streamServer:=TMemoryStream.Create;
        jpgimg.SaveToStream(asd);
        //AContext.Connection.IOHandler.Write(asd, 0, True);
        AContext.Connection.Socket.Write(asd, 0, True);
        jpgimg.Free;
        asd.Clear;
        asd.Free;
      end;
      if ifCoord='coord' then
      begin
        i := pos('_', readConnect);
        if i > 0 then
          begin
            sLeftCoord := copy(readConnect, 6, i - 6);
            sRigthCoord := copy(readConnect, i + 1, Length(readConnect) - i);
            SetCursorPos(StrToInt(sLeftCoord), StrToInt(sRigthCoord));
            form1.Caption:=  sLeftCoord;
          end;
    end;
end;
Все бы ничего но вот когда передлал на джипег переодически вываливается ошибка:
"Connection Closed Gracefully". Даже не знаю куда копать....
Не могу понять почему сервер отклоняет соединение, причем потом клиент сразу же переподключается и в принципе норм... Есть у кого нибудь идеи ? Еще не могу понять разницы и что лучше использовать tcpClient.IOHandler.WriteLn или tcpClient.Socket.WriteLn
Скорость отрисовки к стате намного лучше чем я ожидал )

Последний раз редактировалось j0hnlem0n; 19.09.2015 в 10:43.
j0hnlem0n вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Управление удаленным рабочим столом ikot Работа с сетью в Delphi 44 09.06.2015 23:20
Проблема с рабочим столом pionerka Windows 3 22.05.2013 23:18
Проблема с рабочим столом barsiva Компьютерное железо 5 06.10.2011 12:48
Проблемы с рабочим столом Максим_Кем Операционные системы общие вопросы 4 16.01.2011 15:22
Проблема с рабочим столом. VintProg Свободное общение 5 21.08.2010 14:36