Последние записи

made in programmersforum 3

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

28th
Сен

Прием изображений

Posted by maloy under Delphi, Архив

Terran

Помогите пожалуста решить проблему. Как написать код, что бы через ClientSocket он принимал полученный скриншот и выводил его в Image?

 procedure TForm1.Button1Click(Sender: TObject);

begin

ClientSocket1.Active:=true;

ClientSocket1.Socket.SendText('R');

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;

Socket: TCustomWinSocket);

....

begin

....

end;

Вот код получения скриншота и отправки его на ClientSocket:

procedure TForm1.ServerSocket1ClientRead(Send er: TObject;

Socket: TCustomWinSocket);

var

s: string;

ms: TMemoryStream;

bmp: Graphics.TBitmap;

DC: HDC;

begin

if Socket.ReceiveText = 'R' then

begin

ms := TMemoryStream.Create;

bmp := TBitmap.Create;

bmp.Height := Screen.Height;

bmp.Width := Screen.Width;

DC := GetDC(0);

BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width,

bmp.Height, DC, 0, 0, SRCCopy);

try

bmp.SaveToStream(ms);

ms.Position := 0;

Socket.SendText(IntToStr(ms.Size) + #0);

Socket.SendStream(ms);

except

ms.Free;

end;

bmp.Destroy;

ReleaseDC(0, DC);

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

ServerSocket1.Active:=true;

end;

BOBAH13

У меня сколько не пробывал не получилось отправлять потоки SendStream. Потом были мелкие проблемы с использованием данных компонентов. А на самом деле все делается так

uses

WinSock;
...
function SendBuffer(Socket: TSocket; Buffer: Pointer; Len: Integer): Integer;

var

i: Integer;

n: Integer;

begin

i := 0;

if Socket <> INVALID_SOCKET then

repeat

n := send(Socket, Pointer(Integer(Buffer) + i)^, (Len - i), 0);

if (n = SOCKET_ERROR) or (n = 0) then

Break;

i := i + n;

until

(i = Len);

Result := i;

end;
...
Bmp: TBitmap;

{

Я не помню точно но вроде в TMemoryStream есть параметр Data - указывает на область в памяти,

ну вот и пишим битмап в него, а потом

}

Str: TMemoryStream;
...

Len: Integer;

Len := Str.Size;

Send(Socket.Handle, Len, SizeOf(Len), 0); // посылаем размер

SendBuffer(Socket.Handle{вроде хендл}, Str.Data, Str.Size); // отправка
// на счет получения
{

есть очень интересные вещи в винсок, и честно говоря для меня легче

на апи писать чем отходить и думать с компонентами ( сокетами ).

Реализовал на апи в потоке может и подойдет к Вам

}
var

FDSet: TFDSet;

TimeVal: TTimeVal;

Len: Integer;

LenBmp: Integer; // Размер нашего битмапа

Str: TMemoryStream; // Ваш поток потом из него в битмап.

Buf: Pointer;

begin

while true{Ваше условие, для потока вне вашего приложения

это нормально} do

begin

FD_ZERO(FDSet);

FD_SET(Socket.Handle, FDSet);

TimeVal.tv_sec := 0;

TimeVal.tv_usec := 500;

if (select(0, @FDSet, NIL, NIL, @TimeVal) > 0) and true{Ваше условие

как и вверху} then

begin

ioctlsocket(Socket.Handle, FIONREAD, Len);

if Len = 0 then Break else

begin

if (Str = NIL) and (LenBmp = 0) then // значит еше битмап не грузится

begin

// можете проверить даже, т.е. SizeOf(LenBmp) = Len ?

Str := TMemoryStream.Create;

recv(Socket.Handle, LenBmp, SizeOf(LenBmp), 0);

end else // иначе дописуем поток

begin

GetMem(Buf, Len);

// а тут Вы получаете буфер - пакет, размер его = Len

recv(Socket.Handle, Buf^, Len, 0);

Str.Write(Buf^, Len);

FreeMem(Buf);

if Str.Size = LenBmp then // все докачали

begin

Bmp.LoadFromStream(Str);

Str.Free;

LenBmp := 0;

end;

end;

end;

end;

end;