Удаленное управление рабочим столом

[Stilet]

Это не ошибка. Это оповещение о закрытии соединения. Запусти программу не из под Делфи и посмотри будет такая "ошибка" или нет.

[j0hnlem0n]

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

[Stilet]

Сервер закрывает когда передача данных успешно завершена и соединение более не нужно. Логика как бы простая: Подключились - передали - получили ответ - отключились. Я не особо могу похвалить ИНДИ за это, но так у них устроено.

[Slym]

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

procedure TForm1.tcpServerExecute(AContext: TIdContext);
begin
  while AContext.Connection.Connected do
  begin
  //... твой код
  end;
end;

[j0hnlem0n]

procedure TForm1.tcpServerExecute(AContext: TIdContext);
begin
  while AContext.Connection.Connected do
  begin
  //... твой код
  end;
end;

Спасибо немного помогло, но после минут 10 теста начала опять вываливаться (

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

[Slym]

Весь код давай, сложно представить что там намудрил...

[j0hnlem0n]

Сообщение от 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]

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

[Stilet]

можно какую то команду посылать? как это все правильно обрабатывать ?

Я именно так и делаю. Посылаю битовый код.

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;

[j0hnlem0n]

как то все соложновато )