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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 19.09.2015, 11:17   #11
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Это не ошибка. Это оповещение о закрытии соединения. Запусти программу не из под Делфи и посмотри будет такая "ошибка" или нет.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.09.2015, 11:41   #12
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

да это я понимаю) а из за чего сервер закрывает то его, висит какая то обработка? почему с бмп татих проблем не было ? как отследить не пойму вообще...

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

Сервер закрывает когда передача данных успешно завершена и соединение более не нужно. Логика как бы простая: Подключились - передали - получили ответ - отключились. Я не особо могу похвалить ИНДИ за это, но так у них устроено.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.09.2015, 12:10   #14
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

ты не должен вываливаться из tcpServerExecute пока нет необходимости
т.е.

Код:
procedure TForm1.tcpServerExecute(AContext: TIdContext);
begin
  while AContext.Connection.Connected do
  begin
  //... твой код
  end;
end;
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 19.09.2015, 12:44   #15
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

Код:
procedure TForm1.tcpServerExecute(AContext: TIdContext);
begin
  while AContext.Connection.Connected do
  begin
  //... твой код
  end;
end;
Спасибо немного помогло, но после минут 10 теста начала опять вываливаться (

может на клиенте в таймере еще нужна какая то обработка ? Как бы диагностировать проблемку...

Последний раз редактировалось Stilet; 19.09.2015 в 15:39.
j0hnlem0n вне форума Ответить с цитированием
Старый 19.09.2015, 18:19   #16
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

Весь код давай, сложно представить что там намудрил...
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 20.09.2015, 09:36   #17
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

Цитата:
Сообщение от Slym Посмотреть сообщение
Весь код давай, сложно представить что там намудрил...
клиент:
Код:
unit itVnc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, jpeg;

type
  TForm1 = class(TForm)
    tcpClient: TIdTCPClient;
    tcpClientImage: TImage;
    tcpTimer: TTimer;
    procedure tcpTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tcpClientImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var valueHost:string;
    valuePort:string;
begin
  valueHost := InputBox('Введите ИП', 'Необходимо ввести ИП адрес', '');
  tcpClient.Host :=  valueHost;
  valuePort := InputBox('Введите порт', 'Необходимо ввести порт', '');
  tcpClient.Port:= StrToInt(valuePort);
  tcpClient.Connect();
//  tcpClient.IOHandler.WriteLn('hello');
tcpTimer.Enabled:=true;
end;

procedure TForm1.tcpClientImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
    mouseCoord: TMouse;
begin
mouseCoord:=TMouse.Create;
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;

end.
сервер:
Код:
unit itVncServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdContext, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdTCPServer, IdCmdTCPServer, Jpeg;

type
  TForm1 = class(TForm)
    tcpServer: TIdTCPServer;
    procedure tcpServerExecute(AContext: TIdContext);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



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;
while AContext.Connection.Connected do
  begin
  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;
end;

end.
j0hnlem0n вне форума Ответить с цитированием
Старый 23.09.2015, 07:36   #18
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

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

Цитата:
можно какую то команду посылать? как это все правильно обрабатывать ?
Я именно так и делаю. Посылаю битовый код.
Код:
procedure TForm1.OnServerRecieve(Sender: TObject);
var cmd:byte; Redirect:Boolean;
begin
//считываем команду (байт)
  cmd:=TServSocket(sender).ReadByte; 
//Если он равен команде запроса участка экрана
  if cmd in [cmdGetScreenWH,cmdCapture] then cli.Host:=TServSocket(sender).RemoteIP;

//Если он равен команде выхода
   if cmd=cmdQuit then Close else
//Если равен команде запроса ширины экрана
     if cmd=cmdGetScreenWH then ScreenWH else
       if cmd=cmdGetScreenWHResponse then GetScreenWH(TServSocket(sender).Stream) else
//Если равен команде установки курсора в позицию
         if cmd=cmdSetMouse then Mouse(TServSocket(sender).Stream) else
           if cmd=cmdSetKeyboard then Keyboard(TServSocket(sender).Stream) else
             if cmd=cmdCapture then Capture(TServSocket(sender).Stream) else
               if cmd=cmdCaptureResponse then Draw(TServSocket(sender).Stream) else
   ;
end;
А вот команда клиента:
Код:
procedure TForm1.SendMouse(UpDown: byte; x, y, wheel: integer;
  Button: TMouseButton);
var m:TMemoryStream;  flag:integer;
begin
  case UpDown of
   1:begin if Button in [mbLeft] then flag:=MOUSEEVENTF_LEFTDOWN else if Button in [mbRight] then flag:=MOUSEEVENTF_RIGHTDOWN; end;
   2:begin if Button in [mbLeft] then flag:=MOUSEEVENTF_LEFTUP   else if Button in [mbRight] then flag:=MOUSEEVENTF_RIGHTUP;   end;
   0:flag:=MOUSEEVENTF_MOVE;
  end;
  x:=round(x/PaintBox1.Width*RemoteScreenWidth);
  y:=round(y/PaintBox1.Height*RemoteScreenHeight);
  cli.Clear;
  cli.WriteByte(cmdSetMouse); //Команда установки курсора мышки
  cli.WriteDWord(MOUSEEVENTF_ABSOLUTE or flag);
  cli.WriteDWord(x); //Ее новые координаты
  cli.WriteDWord(y);
  cli.WriteDWord(wheel); //И счетчик колесика
  cli.Send;
  //m.Free;
end;
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 23.09.2015, 11:16   #20
j0hnlem0n
Пользователь
 
Регистрация: 17.09.2015
Сообщений: 21
По умолчанию

как то все соложновато )
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