Сообщение об ошибке: «Растровое изображение недействительно» при получении от Socket

Я пытаюсь получить снимок экрана и отправить его через Интернет с помощью компонентов ClientSocket и ServerSocket.Сообщение об ошибке: «Растровое изображение недействительно» при получении от Socket

У меня проблемы, когда я пытаюсь снова включить поток, полученный на сервере ServerSocket. Сообщение об ошибке «Растровое изображение недействительно!» при выполнении: DesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms);

Я не знаю, является ли проблема в том, как отправить изображение или мешать.

Мой код сервера:

unit UntThreadDesktop; 

interface 

uses 
    System.Classes, 
    System.SysUtils, 
    System.Win.ScktComp, 
    WinApi.Windows, 
    WinApi.ActiveX, 
    Vcl.Graphics, 
    Vcl.Imaging.Jpeg, 
    UntDesktopForm; 

type 
    TThreadDesktop = class(TThread) 
    private 
    FSocket: TCustomWinSocket; 
    FDesktopForm: TDesktopForm; 
    public 
    constructor Create(ASocket: TCustomWinSocket); 
    destructor Destroy; override; 
    procedure Execute; override; 
    end; 

implementation 

uses 
    UntLibraries; 

{ TThreadDesktop } 

constructor TThreadDesktop.Create(ASocket: TCustomWinSocket); 
begin 
    inherited Create(true); 
    FreeOnTerminate := true; 
    FSocket := ASocket; 
end; 

destructor TThreadDesktop.Destroy; 
begin 
    inherited; 
end; 

procedure TThreadDesktop.Execute; 
var 
    text: string; 
    fileSize: integer; 
    ms: TMemoryStream; 
    buf: Pointer; 
    nBytes: integer; 
    jpg: TJPEGImage; 
begin 
    inherited; 
    CoInitialize(nil); 
    try 

    // Init DesktopForm 
    Synchronize(procedure begin 
     FDesktopForm := TDesktopForm.Create; 
     FDesktopForm.Show; 
    end); 

    ms := TMemoryStream.Create; 

    try 

     FSocket.SendText('<|GetScreen|>'); 
     while FSocket.Connected and (not Self.Terminated) and (FDesktopForm <> nil) do 
     begin 

     if FSocket.ReceiveLength > 0 then 
     begin 

      ms.Clear; 

      text := string(FSocket.ReceiveText); 
      text := Copy(text,1, Pos(#0,text)-1); 
      fileSize := StrToInt(text); 

      // Receiving file 
      while FSocket.Connected and (not Self.Terminated) and (FDesktopForm <> nil) do 
      begin 
      Synchronize(procedure begin 
       if FDesktopForm <> nil then 
       FDesktopForm.panInfo.Caption := 'Total: ' + IntToStr(ms.Size) + 
       ' de ' + IntToStr(fileSize); 
      end); 

      try 
       text := ''; 
       GetMem(buf, FSocket.ReceiveLength); 
       try 
       nBytes := FSocket.ReceiveBuf(buf^, FSocket.ReceiveLength); 
       if nBytes > 0 then 
        ms.Write(buf^, nBytes); 
       if (ms.Size = fileSize) or (nBytes <= 0) then 
       begin 
        ms.Position := 0; 
        ms.SaveToFile('C:\Temp\Screen.bmp'); 
        ms.Position := 0; 
        //jpg := TJPEGImage.Create; 
        //jpg.LoadFromStream(ms); 
        // Carrega a imagem 
        Synchronize(procedure begin 
        if FDesktopForm <> nil then 
         //FDesktopForm.imgScreen.Picture.Assign(jpg); 
         FDesktopForm.imgScreen.Picture.Graphic.LoadFromStream(ms); 
        end); 
       end; 
       finally 
       FreeMem(buf); 
       end; 
      except 
      end; 
      end; 

     end; 

     TThread.Sleep(10); 
     end; 

    finally 
     ms.Free; 

     // Close DesktopForm 
     Synchronize(procedure begin 
     if FDesktopForm <> nil then 
      FDesktopForm.Close; 
     end); 
    end; 

    finally 
    CoUninitialize; 
    end; 
end; 

end.

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

В основной форме моего сервера приложений у меня есть компонент TServerSocket, работающий с свойством ServerType для stThreadBlocking.

В моем клиентском приложении у меня есть компонент TClientSocket, используя свойство ClientType как ctNonBlocking.

Мой код Темы:

unit UntThreadDesktopClient; 

interface 

uses 
    System.Classes, 
    System.SysUtils, 
    System.Win.ScktComp, 
    WinApi.Windows, 
    WinApi.ActiveX, 
    Vcl.Imaging.Jpeg, 
    Vcl.Graphics, 
    Vcl.Forms; 

type 
    TThreadDesktopClient = class(TThread) 
    private 
    FSocket: TClientSocket; 
    FStream: TMemoryStream; 
    public 
    constructor Create(AHostname: string; APort: integer); reintroduce; 
    destructor Destroy; override; 
    procedure Execute; override; 
    private 
    procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure GetScreen(stream: TMemoryStream); 
    end; 

implementation 

{ TThreadDesktopClient } 

constructor TThreadDesktopClient.Create(AHostname: string; APort: integer); 
begin 
    inherited Create(true); 
    FreeOnTerminate := true; 

    FStream := TMemoryStream.Create; 

    FSocket := TClientSocket.Create(nil); 
    FSocket.ClientType := ctNonBlocking; 
    FSocket.Host := AHostname; 
    FSocket.Port := APort; 
    FSocket.OnConnect := OnConnect; 
    FSocket.Open; 
end; 

destructor TThreadDesktopClient.Destroy; 
begin 
    FStream.Free; 
    if FSocket.Active then 
    FSocket.Close; 
    FSocket.Free; 
    inherited; 
end; 

procedure TThreadDesktopClient.Execute; 
var 
    cmd: AnsiString; 
begin 
    inherited; 
    CoInitialize(nil); 
    try 
    while FSocket.Active and not Self.Terminated do 
    begin 
     if FSocket.Socket.ReceiveLength > 0 then 
     begin 
     cmd := FSocket.Socket.ReceiveText; 
     if cmd = '<|GetScreen|>' then 
     begin 
      FStream.Clear; 
      GetScreen(FStream); 
      FStream.Position := 0; 
      FSocket.Socket.SendText(AnsiString(IntToStr(FStream.Size)) + #0); 
      FSocket.Socket.SendStream(FStream); 
     end 
     else 
     if cmd = '<|TYPE|>' then 
     begin 
      FSocket.Socket.SendText('<|TYPE-DESKTOP|>'); 
     end; 
     end; 
    end; 
    finally 
    CoUninitialize; 
    end; 
end; 

procedure TThreadDesktopClient.OnConnect(Sender: TObject; Socket: TCustomWinSocket); 
begin 
    Start; 
end; 

procedure TThreadDesktopClient.GetScreen(stream: TMemoryStream); 
var 
    DC: HDC; 
    bmp: TBitmap; 
    jpg: TJPEGImage; 
begin 
    DC := GetDC(GetDesktopWindow); 
    try 
    bmp := TBitmap.Create; 
    jpg := TJPEGImage.Create; 
    try 
     //bmp.PixelFormat := pf8bit; 
     bmp.Width := GetDeviceCaps(DC, HORZRES); 
     bmp.Height := GetDeviceCaps(DC, VERTRES); 
     //bmp.Width := Screen.Width; 
     //bmp.Height := Screen.Height; 
     BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, DC, 0, 0, SRCCOPY); 
     bmp.Modified := True; 
     //jpg.Assign(bmp); 
     //jpg.Compress; 
     stream.Clear; 
     //jpg.SaveToStream(stream); 
     bmp.SaveToStream(stream); 
    finally 
     bmp.Free; 
     jpg.Free; 
    end; 
    finally 
    ReleaseDC(GetDesktopWindow, DC); 
    end; 
end; 

end.

Для дальнейшего уточнения, я буду также пост моего основного потока клиентского приложения и как это называется в главной форме от моего клиентского приложения.

unit UntThreadMain; 

interface 

uses 
    System.Classes, 
    System.Win.ScktComp, 
    WinApi.ActiveX; 

type 
    TThreadMain = class(TThread) 
    private 
    FClientSocket: TClientSocket; 
    public 
    constructor Create(AHostname: string; APort: integer); reintroduce; 
    destructor Destroy; override; 
    procedure Execute; override; 
    public 
    procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure OnDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure OnError(Sender: TObject; Socket: TCustomWinSocket; 
     ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
    private 
    procedure SendInfo; 
    procedure OpenDesktopChannel; 
    end; 

implementation 

uses 
    UntClientMainForm, 
    UntThreadDesktopClient; 

{ TThreadMain } 

constructor TThreadMain.Create(AHostname: string; APort: integer); 
begin 
    inherited Create(true); 
    FreeOnTerminate := false; 
    FClientSocket := TClientSocket.Create(nil); 
    FClientSocket.ClientType := ctNonBlocking; 
    FClientSocket.Host := AHostname; 
    FClientSocket.Port := APort; 
    FClientSocket.OnConnect := OnConnect; 
    FClientSocket.OnDisconnect := OnDisconnect; 
    FClientSocket.Open; 
end; 

destructor TThreadMain.Destroy; 
begin 
    if FClientSocket.Active then 
    FClientSocket.Close; 
    FClientSocket.Free; 
    inherited; 
end; 

procedure TThreadMain.Execute; 
var 
    cmd: AnsiString; 
begin 
    inherited; 
    CoInitialize(nil); 
    try 
    while FClientSocket.Socket.Connected and not Self.Terminated do 
    begin 
     if FClientSocket.Socket.ReceiveLength > 0 then 
     begin 
     cmd := FClientSocket.Socket.ReceiveText; 
     if cmd = '<|TYPE|>' then 
      FClientSocket.Socket.SendText('<|TYPE-COMMAND|>') 
     else 
     if cmd = '<|INFO|>' then 
      SendInfo 
     else 
     if cmd = '<|REQUEST-DESKTOP|>' then 
      TThreadDesktopClient.Create(FClientSocket.Host, FClientSocket.Port); 
     end; 
    end; 
    finally 
    CoUninitialize; 
    end; 
end; 

procedure TThreadMain.OnConnect(Sender: TObject; Socket: TCustomWinSocket); 
begin 
    Start; 
    Synchronize(procedure 
    begin 
    ClientMainForm.stBar.Panels[1].Text := 'Conectado'; 
    ClientMainForm.btnConectar.Caption := 'Desconectar'; 
    end); 
end; 

procedure TThreadMain.OnDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
begin 
    Synchronize(procedure 
    begin 
    ClientMainForm.stBar.Panels[1].Text := 'Desconectado'; 
    ClientMainForm.btnConectar.Caption := 'Conectar'; 
    end); 
end; 

procedure TThreadMain.OnError(Sender: TObject; Socket: TCustomWinSocket; 
    ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
begin 
    ErrorCode := 0; 
end; 

procedure TThreadMain.SendInfo; 
var 
    cmd: AnsiString; 
begin 
    cmd := '<|INFO|>;NomePC=Tiago-PC;SO=Windows Seven Professiona 64-bit;' + 
    'CPU=Intel Core i7 3ª Geração'; 
    FClientSocket.Socket.SendText(cmd); 
end; 

end.

Обратите внимание, что этот поток вызывает TThreadDesktopClient.

В основной форме сервера приложений, где в TServerSocket, получил OnGetThread TServerSocket метод так:

procedure TMainForm.ServerSocketGetThread(Sender: TObject; 
    ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread); 
begin 
    SocketThread := TThreadController.Create(false, ClientSocket); 
end;

Когда изображение запрашивается:

procedure TMainForm.pmiAcessarClick(Sender: TObject); 
var 
    nI: integer; 
begin 
    for nI := 0 to Pred(ServerSocket.Socket.ActiveConnections) do 
    begin 
    if ServerSocket.Socket.Connections[nI].SocketHandle = cdsClientesId.AsInteger then 
     ServerSocket.Socket.Connections[nI].SendText('<|REQUEST-DESKTOP|>'); 
    end; 
end;

Возвращаясь к моему клиентскому приложению , этот код используется для подключения на сервере (TServerSocket).

procedure TClientMainForm.btnConectarClick(Sender: TObject); 
begin 
    if FThreadMain = nil then 
    begin 
    FThreadMain := TThreadMain.Create('localhost', 6550); 
    end 
    else 
    begin 
    FThreadMain.Terminate; 
    FThreadMain.Free; 
    FThreadMain := nil; 
    end; 
end;

Итак, это все мой код.
Когда получено изображение, я пытаюсь загрузить его на TImage, чтобы получить сообщение об ошибке: «Растровое изображение недействительно».

Я пробовал несколько различных способов обработки потока, отправленного клиентским приложением. Но он все еще терпит неудачу.
Обычно такая же ошибка: «Растровое изображение недействительно».

источник

2013-11-29 Anonymous

Вы пробовали сохранения бокового потока сервера в файл на диске вместо этого, и проверять заголовок файла, чтобы увидеть, если это действительный растровый? –

Да, я проверил это, и изображение испорчено. И я вижу, что размер потока, который я отправил, составляет 5184054, но я получил только 5175870. Вы знаете, почему это происходит?! –

Зачем вы пропустили клиенту, а затем установили, что сокет не блокируется? –

Есть целый ЛОТ проблем с кодом вы показали, - начиная от фундаментального недостатка понимания того, как TClientSocket и TServerSocket фактически работают в целом, отсутствие понимания того, как отправить/получить/разобрать через TCP/IP. Я вижу очень мало вещей в вашем коде, которые верны.

Вы создаете несколько соединений на стороне клиента, каждый из которых определяет его тип (команда против рабочего стола), но ваш код сервера не запрашивает этот тип или даже не заботится о том, что такое тип. Он предполагает, что каждый клиент является настольным клиентом и запрашивает его экран. Таким образом, вы можете упростить свой код с обеих сторон, просто исключив это второе соединение.В любом случае, это действительно не нужно. Вы сократите свои соединения до минимума, чтобы уменьшить накладные расходы.

Я бы настоятельно рекомендовал переписать код.

Попробуйте что-то больше, как это вместо:

Общую:

unit UntSocketCommon; 

uses 
    System.Classes, 
    System.Win.ScktComp; 

interface 

procedure ReadRawFromSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer); 
function ReadLineFromSocket(Socket: TWinSocketStream): String; 
function ReadIntegerFromSocket(Socket: TWinSocketStream): Integer; 
procedure ReadStreamFromSocket(Socket: TWinSocketStream; Stream: TStream); 

procedure WriteRawFromSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer); 
procedure WriteLineToSocket(Socket: TWinSocketStream; const Value: String); 
procedure WriteIntegerToSocket(Socket: TWinSocketStream; Value: Integer); 
procedure WriteStreamToSocket(Socket: TWinSocketStream; Stream: TStream); 

implementation 

procedure ReadRawFromSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer); 
var 
    PBuf: PByte; 
    nBytesRead: Integer; 
begin 
    PBuf := PByte(Buf); 
    while BufLen > 0 do 
    begin 
    nBytesRead := Socket.Read(PBuf^, BufLen); 
    if nBytesRead < 1 then raise Exception.Create('Unable to read from socket'); 
    Inc(PBuf, nBytesRead); 
    Dec(BufLen, nBytesRead); 
    end; 
end; 

function ReadLineFromSocket(Socket: TWinSocketStream): String; 
var 
    Ch: AnsiChar; 
    Buf: array[0..255] of AnsiChar; 
    BufLen: Integer; 
    S: UTF8String; 

    procedure AppendBuf; 
    var 
    OldLen: Integer; 
    begin 
    OldLen := Length(S); 
    SetLength(S, OldLen + BufLen); 
    Move(Buf[0], S[OldLen], BufLen); 
    end; 

begin 
    Result := ''; 
    BufLen := 0; 
    repeat 
    ReadRawFromSocket(Socket, @Ch, SizeOf(Ch)); 
    if Ch = #10 then Break; 
    if BufLen = Length(Buf) then 
    begin 
     AppendBuf; 
     BufLen := 0; 
    end; 
    Buf[BufLen] := Ch; 
    Inc(BufLen); 
    until False; 
    if BufLen > 0 then AppendBuf; 
    BufLen := Length(S); 
    if BufLen > 0 then 
    begin 
    if S[BufLen] = #13 then 
     SetLength(S, BufLen-1); 
    end; 
    Result := String(S); 
end; 

function ReadIntegerFromSocket(Socket: TWinSocketStream): Integer; 
begin 
    ReadRawFromSocket(Socket, @Result, SizeOf(Result)); 
    Result := ntohl(Result); 
end; 

procedure ReadStreamFromSocket(Socket: TWinSocketStream; Stream: TStream); 
var 
    Size: Integer; 
    Buf: array[0..1023] of Byte; 
    nBytes: Integer; 
begin 
    Size := ReadIntegerFromSocket(Socket); 
    while Size > 0 do 
    begin 
    nBytes := Size; 
    if nBytes > Length(Buf) then nBytes := Length(Buf); 
    ReadRawFromSocket(Socket, Buf[0], nBytes); 
    Stream.WriteBuffer(Buf[0], nBytes); 
    Dec(Size, nBytes); 
    end; 
end; 

procedure WriteRawToSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer); 
var 
    PBuf: PByte; 
    nBytesWritten: Integer; 
begin 
    PBuf := PByte(Buf); 
    while BufLen > 0 do 
    begin 
    nBytesWritten := Socket.Write(PBuf^, BufLen); 
    if nBytesWritten < 1 then raise Exception.Create('Unable to write to socket'); 
    Inc(PBuf, nBytesWritten); 
    Dec(BufLen, nBytesWritten); 
    end; 
end; 

procedure WriteLineToSocket(Socket: TWinSocketStream; const Value: String); 
var 
    S: UTF8String; 
begin 
    S := UTF8String(Value + #13#10); 
    WriteRawToSocket(Socket, PAnsiChar(S), Length(S)); 
end; 

procedure WriteIntegerToSocket(Socket: TWinSocketStream; Value: Integer); 
begin 
    Value := htonl(Value); 
    WriteRawToSocket(Socket, @Value, SizeOf(Value)); 
end; 

procedure WriteStreamToSocket(Socket: TWinSocketStream; Stream: TStream); 
var 
    Size: Integer; 
    Buf: array[0..1023] of Byte; 
    nBytes: Integer; 
begin 
    Size := Stream.Size - Stream.Position; 
    WriteIntegerToSocket(Socket, Size); 
    while Size > 0 do 
    begin 
    nBytes := Size; 
    if nBytes > Length(Buf) then nBytes := Length(Buf); 
    Stream.ReadBuffer(Buf[0], nBytes); 
    WriteRawToSocket(Socket, Buf[0], nBytes); 
    Dec(Size, nBytes); 
    end; 
end; 

end.

Сервер:

unit UntThreadDesktop; 

interface 

uses 
    System.Classes, 
    System.Win.ScktComp, 
    UntDesktopForm; 

type 
    TThreadController = class(TServerClientThread) 
    private 
    FDesktopForm: TDesktopForm; 
    protected 
    procedure ClientExecute; override; 
    end; 

implementation 

uses 
    System.SysUtils, 
    WinApi.Windows, 
    Vcl.Graphics, 
    UntLibraries, 
    UntSocketCommon; 

{ TThreadDesktop } 

procedure TThreadController.ClientExecute; 
var 
    fileSize: Integer; 
    ms: TMemoryStream; 
    buf: array[0..1023] of Byte; 
    nBytes: Integer; 
    SocketStrm: TWinSocketStream; 
begin 
    SocketStrm := TWinSocketStream.Create(ClientSocket, 5000); 
    try 
    // Init DesktopForm 
    Synchronize(
     procedure 
     begin 
     FDesktopForm := TDesktopForm.Create; 
     FDesktopForm.Show; 
     end 
    ); 

    try 
     ms := TMemoryStream.Create; 
     try 
     while ClientSocket.Connected and (not Terminated) and (FDesktopForm <> nil) do 
     begin 
      ms.Clear; 

      WriteLineToSocket(SocketStrm, '<|GetScreen|>'); 

      { 
      ReadStreamFromSocket(SocketStrm, ms); 
      ms.Position := 0; 
      ms.SaveToFile('C:\Temp\Screen.bmp'); 
      ms.Position := 0; 
      Synchronize(
      procedure 
      begin 
       if FDesktopForm <> nil then 
       FDesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms); 
      end 
     ); 
      } 

      fileSize := ReadIntegerFromSocket(SocketStrm); 

      while (ms.Size < fileSize) and ClientSocket.Connected and (not Terminated) and (FDesktopForm <> nil) do 
      begin 
      Synchronize(
      procedure 
       begin 
       if FDesktopForm <> nil then 
        FDesktopForm.panInfo.Caption := 'Total: ' + IntToStr(ms.Size) + ' de ' + IntToStr(fileSize); 
       end 
      ); 

      nBytes := fileSize - ms.Size; 
      if nBytes > Length(Buf) then nBytes := Length(Buf); 

      ReadRawFromSocket(SocketStrm, buf[0], nBytes); 
      ms.WriteBuffer(buf[0], nBytes); 

      if ms.Size = fileSize then 
      begin 
       ms.Position := 0; 
       ms.SaveToFile('C:\Temp\Screen.bmp'); 
       ms.Position := 0; 
       Synchronize(
       procedure 
       begin 
        if FDesktopForm <> nil then 
        FDesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms); 
       end 
      ); 
      end; 
      end; 
     end; 
     finally 
     ms.Free; 
     end; 
    finally 
     Synchronize(
     procedure 
     begin 
      if FDesktopForm <> nil then 
      FDesktopForm.Close; 
     end 
    ); 
    end; 
    finally 
    SocketStrm.Free; 
    end; 
end; 

end.

procedure TMainForm.ServerSocketGetThread(Sender: TObject; 
    ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread); 
begin 
    SocketThread := TThreadController.Create(false, ClientSocket); 
end;

Клиент:

unit UntThreadMain; 

interface 

uses 
    System.Classes, 
    System.Win.ScktComp; 

type 
    TThreadMain = class(TThread) 
    private 
    FClientSocket: TClientSocket; 
    FSocketStrm: TWinSocketStream; 
    procedure SendInfo; 
    procedure SendScreen; 
    procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure OnDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure OnError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
    protected 
    procedure Execute; override; 
    public 
    constructor Create(AHostname: string; APort: integer); reintroduce; 
    destructor Destroy; override; 
    end; 

implementation 

uses 
    System.SysUtils, 
    WinApi.Windows, 
    Vcl.Graphics, 
    UntClientMainForm, 
    UntSocketCommon; 

{ TThreadMain } 

constructor TThreadMain.Create(AHostname: string; APort: integer); 
begin 
    inherited Create(false); 
    FreeOnTerminate := false; 

    FClientSocket := TClientSocket.Create(nil); 
    FClientSocket.ClientType := ctBlocking; 
    FClientSocket.Host := AHostname; 
    FClientSocket.Port := APort; 
    FClientSocket.OnConnect := OnConnect; 
    FClientSocket.OnDisconnect := OnDisconnect; 
    FClientSocket.OnError := OnError; 
end; 

destructor TThreadMain.Destroy; 
begin 
    FClientSocket.Free; 
    inherited; 
end; 

procedure TThreadMain.Execute; 
var 
    SocketStrm: TWinSocketStream; 
    cmd: String; 
begin 
    FClientSocket.Open; 
    try 
    FSocketStrm := TWinSocketStream.Create(FClientSocket.Socket, 5000); 
    try 
     while FClientSocket.Socket.Connected and (not Terminated) do 
     begin 
     if SocketStrm.WaitForData(1000) then 
     begin 
      cmd := ReadLineFromSocket(SocketStrm); 
      if cmd = '<|INFO|>' then 
      begin 
      SendInfo 
      end 
      else if cmd = '<|GetScreen|>' then 
      begin 
      SendScreen; 
      end 
     end; 
     end; 
    finally 
     FSocketStrm.Free; 
    end; 
    finally 
    FClientSocket.Close; 
    end; 
end; 

procedure TThreadMain.OnConnect(Sender: TObject; Socket: TCustomWinSocket); 
begin 
    Synchronize(
    procedure 
    begin 
     ClientMainForm.stBar.Panels[1].Text := 'Conectado'; 
     ClientMainForm.btnConectar.Caption := 'Desconectar'; 
    end 
); 
end; 

procedure TThreadMain.OnDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
begin 
    Synchronize(
    procedure 
    begin 
     ClientMainForm.stBar.Panels[1].Text := 'Desconectado'; 
     ClientMainForm.btnConectar.Caption := 'Conectar'; 
    end 
); 
end; 

procedure TThreadMain.OnError(Sender: TObject; Socket: TCustomWinSocket; 
    ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
begin 
    ErrorCode := 0; 
    Socket.Close; 
end; 

procedure TThreadMain.SendInfo; 
var 
    cmd: string; 
begin 
    cmd := '<|INFO|>;NomePC=Tiago-PC;SO=Windows Seven Professiona 64-bit;CPU=Intel Core i7 3ª Geração'; 
    WriteLineToSocket(FSocketStrm, cmd); 
end; 

procedure TThreadMain.SendScreen; 
var 
    DC: HDC; 
    bmp: TBitmap; 
    ms: TMemoryStream; 
begin 
    ms := TMemoryStream.Create; 
    try 
    bmp := TBitmap.Create; 
    try 
     DC := GetDC(0); 
     try 
     //bmp.PixelFormat := pf8bit; 
     bmp.Width := GetDeviceCaps(DC, HORZRES); 
     bmp.Height := GetDeviceCaps(DC, VERTRES); 
     //bmp.Width := Screen.Width; 
     //bmp.Height := Screen.Height; 
     BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, DC, 0, 0, SRCCOPY); 
     finally 
     ReleaseDC(0, DC); 
     end; 
     bmp.SaveToStream(ms); 
    finally 
     bmp.Free; 
    end; 
    ms.Position := 0; 
    WriteStreamToSocket(FSocketStrm, ms); 
    finally 
    ms.Free; 
    end; 
end; 

end.

procedure TClientMainForm.btnConectarClick(Sender: TObject); 
begin 
    if FThreadMain = nil then 
    begin 
    FThreadMain := TThreadMain.Create('localhost', 6550); 
    end else 
    begin 
    FThreadMain.Terminate; 
    FThreadMain.WaitFor; 
    FThreadMain.Free; 
    FThreadMain := nil; 
    end; 
end;

источник

2013-12-01 02:38:43

Спасибо, очень! –

Сообщение об ошибке: «Растровое изображение недействительно» при получении от Socket

ответ

Смежные вопросы