изображение по локальной сети

[stlcrash]

Спасибо за подсказки. Вышло
Проект прикрепил.
PS клиент и сервер не должны быть в 1й папке.

Только не получилось сделать без сохранения скриншота на компьютер

[Пепел Феникса]

читайте пост 9 тогда

[stlcrash]

хм. Не получается разобраться.
как я тогда узнаю размер скриншота не сохраняя его на диск?

        if FileExists(edt1.Text) then
            begin
              cmd.Clear;
              getfsize := TFileStream.Create(edt1.Text, fmOpenRead);
              cmd.Add(ExtractFileName(edt1.Text));
              cmd.Add(IntToStr(getfsize.Size));
              getfsize.Free;

              // уведомление клиента о передаче файла
              // отправляется имя и размер файла посредство размещения
              // данных в cmd (TStringList)
              ServerSocket1.Socket.Connections[0].SendText(cmd.Text);
            end;

[Пепел Феникса]

при отправке файл тоже не нужен, TBitmap отлично сохраняется в TMemoryStream тоже

[stlcrash]

Сообщение от Пепел Феникса

при отправке файл тоже не нужен, TBitmap отлично сохраняется в TMemoryStream тоже

я ее просто сначала в Jpeg конвертирую, чтоб передавать меньший объем данных

[Пепел Феникса]

JPEG тоже отлично сохраняется в поток

[stlcrash]

Не понимаю где здесь происходит сохранение полученного файла на диск?
И как его убрать, чтоб не сохранялся на жесткий диск

unit UnitClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Gauges, ScktComp, ComCtrls, Vcl.ExtCtrls, Vcl.Imaging.jpeg;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    RxRichEdit1: TMemo;
    Image1: TImage;
    Button1: TButton;
    Edit1: TEdit;
    Gauge1: TGauge;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Jornal(txt: string);
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
  private
    Receiving : Boolean;
    cmd : TStringList;
    fName : string;
    fSize : Int64;
    fs : TFileStream;
    { Private declarations }
  public
    { Public declarations }
  end;

const
  bSize : Integer = 4000;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ClientSocket1.Active then ClientSocket1.Active := False;
if Assigned(cmd) then cmd.Free;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  nRead : Integer;
  rBuf : Pointer;
  jpeg: TJPEGImage;
  bmp:  TBitmap;
begin
// если не находимся в режиме получения файла, то значит пришли команды
// в нашем случае это имя и размер файла
if not Receiving then //получение команды - параметров файла
  begin
      cmd.Text := Socket.ReceiveText;

      fName := cmd.Strings[0];
      fSize := StrToInt64(cmd.Strings[1]);
      Jornal('Прием файла ' + QuotedStr(cmd.Strings[0]));
      Jornal('Размер файла ' + QuotedStr(cmd.Strings[1]));

      Gauge1.MinValue := 0;
      Gauge1.Progress := 0;
      Gauge1.MaxValue := fSize;
      Jornal('------------------------------------------');

      // переход в режим приема файла  и создание потока для приема файла
      Receiving := True;

      fs := TFileStream.Create(fName, fmCreate);

      Gauge1.Progress := 0;
      //Уведомление сервера о готовности приема файла
      cmd.Clear;
      cmd.Add('send');
      cmd.Add(fName);
      Socket.SendText(cmd.Text);
  end
else // режим получения файла
  begin
    repeat
      Socket.Lock;
      // выделение памяти под принятый кусок данных
      GetMem(rBuf, bSize + 1);
      // считывание данных nRead = количество считанных байт
      nRead := Socket.ReceiveBuf(rBuf^, bSize);
      // если что то считалось, то запись данных в файл

      if nRead > 0 then
        begin
          //fs.Seek(0, soFromEnd);
          fs.WriteBuffer(rBuf^, nRead);
          Gauge1.Progress := fs.Size;
        end;

      FreeMem(rBuf);
      Socket.Unlock;
      Application.ProcessMessages;
    until (nRead <= 0);

    // если всё данные считались, то переключение режима приема обратно и освобождение переменной потока
    if fs.Size = fSize then
       begin
          Receiving := False;

          fs.Position:=0;
          jpeg := TJPEGImage.Create;
          try
            jpeg.CompressionQuality := 100;
            jpeg.LoadFromStream(fs);
            bmp := TBitmap.Create;
            try
              bmp.Assign(jpeg);
              Image1.Picture.Bitmap:=bmp;
            finally
              bmp.Free
            end;
          finally
            jpeg.Free
          end;

          fs.Position:=0;

          fs.free;  //!!!!

          Jornal('Файл принят!');
       end;
  end;
end;


// процедура вывода данных в журнал [текст сообщения, стиль текста, цвет текста]
procedure TForm1.Jornal(txt: string);
var
  time : string;
begin
if txt = '' then Exit;
time := '[' + DateTimeToStr(now) + '] ';
RxRichEdit1.Lines.Add(time+txt);
RxRichEdit1.SelStart := Length(RxRichEdit1.Lines.Text) - Length(time+txt) - RxRichEdit1.Lines.Count - 1;
RxRichEdit1.SelLength := Length(time+txt);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientSocket1.Address:= Edit1.Text;
  ClientSocket1.Active := True;
  Receiving := False;
  cmd := TStringList.Create;
  fSize := 0;
  fName := '';
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
Jornal('> Подключён к серверу [' + Socket.RemoteAddress + ']');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Jornal('< Отключён от сервера [' + Socket.RemoteAddress + ']');
end;

end.

[Пепел Феникса]

посмотрите что такое fs.
и сразу станет ясно.

[stlcrash]

Сообщение от Пепел Феникса

посмотрите что такое fs.
и сразу станет ясно.

unit UnitClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Gauges, ScktComp, ComCtrls, Vcl.ExtCtrls, Vcl.Imaging.jpeg;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    RxRichEdit1: TMemo;
    Image1: TImage;
    Button1: TButton;
    Edit1: TEdit;
    Gauge1: TGauge;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Jornal(txt: string);
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
  private
    Receiving : Boolean;
    cmd : TStringList;
    fName : string;
    fSize : Int64;
    fs : TMemoryStream;
    { Private declarations }
  public
    { Public declarations }
  end;

const
  bSize : Integer = 4000;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ClientSocket1.Active then ClientSocket1.Active := False;
if Assigned(cmd) then cmd.Free;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  nRead : Integer;
  rBuf : Pointer;
  jpeg: TJPEGImage;
  bmp:  TBitmap;
begin
// если не находимся в режиме получения файла, то значит пришли команды
// в нашем случае это имя и размер файла
if not Receiving then //получение команды - параметров файла
  begin
      cmd.Text := Socket.ReceiveText;

      fName := cmd.Strings[0];
      fSize := StrToInt64(cmd.Strings[1]);
      Jornal('Прием файла ' + QuotedStr(cmd.Strings[0]));
      Jornal('Размер файла ' + QuotedStr(cmd.Strings[1]));

      Gauge1.MinValue := 0;
      Gauge1.Progress := 0;
      Gauge1.MaxValue := fSize;
      Jornal('------------------------------------------');

      // переход в режим приема файла  и создание потока для приема файла
      Receiving := True;
      fs := TMemoryStream.Create();
      Gauge1.Progress := 0;
      //Уведомление сервера о готовности приема файла
      cmd.Clear;
      cmd.Add('send');
      cmd.Add(fName);
      Socket.SendText(cmd.Text);
  end
else // режим получения файла
  begin
    repeat
      Socket.Lock;
      // выделение памяти под принятый кусок данных
      GetMem(rBuf, bSize + 1);
      // считывание данных nRead = количество считанных байт
      nRead := Socket.ReceiveBuf(rBuf^, bSize);
      // если что то считалось, то запись данных в файл
      if nRead > 0 then
        begin
          //fs.Seek(0, soFromEnd);
          fs.WriteBuffer(rBuf^, nRead);
          Gauge1.Progress := fs.Size;
        end;
      FreeMem(rBuf);
      Socket.Unlock;
      Application.ProcessMessages;
    until (nRead <= 0);

    // если всё данные считались, то переключение режима приема обратно и освобождение переменной потока
    if fs.Size = fSize then
       begin
          Receiving := False;
          fs.Position:=0;
          jpeg := TJPEGImage.Create;
          try
            jpeg.CompressionQuality := 100;
            jpeg.LoadFromStream(fs);
            bmp := TBitmap.Create;
            try
              bmp.Assign(jpeg);
              Image1.Picture.Bitmap:=bmp;
            finally
              bmp.Free
            end;
          finally
            jpeg.Free
          end;
          fs.Position:=0;
          fs.free;  //!!!!
          Jornal('Файл принят!');
       end;
  end;
end;
// процедура вывода данных в журнал [текст сообщения, стиль текста, цвет текста]
procedure TForm1.Jornal(txt: string);
var
  time : string;
begin
if txt = '' then Exit;
time := '[' + DateTimeToStr(now) + '] ';
RxRichEdit1.Lines.Add(time+txt);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientSocket1.Address:= Edit1.Text;
  ClientSocket1.Active := True;
  Receiving := False;
  cmd := TStringList.Create;
  fSize := 0;
  fName := '';
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
Jornal('> Подключён к серверу [' + Socket.RemoteAddress + ']');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Jornal('< Отключён от сервера [' + Socket.RemoteAddress + ']');
end;

end.

[stlcrash]

С клиентом разобрался, спасибо. Осталось с серверной частью. Там такая же проблемка. Сохраняет скрин на диск.

unit UnitServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Gauges, Mask,  ScktComp,JPEG, Vcl.ExtCtrls,inifiles,
  Vcl.Samples.Spin;

type
  TForm1 = class(TForm)
    Gauge1: TGauge;
    btn1: TButton;
    ServerSocket1: TServerSocket;
    RxRichEdit1: TMemo;
    edt1: TEdit;
    Image1: TImage;
    Timer1: TTimer;
    iniSave: TTimer;
    sendVal: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn1Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Jornal(txt: string);
    procedure SendFileSocket(fName : string);
    procedure Progress(prg, maxprg : Integer);
    procedure wait(interval:integer);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure iniSaveTimer(Sender: TObject);
  private
    fs : TFileStream;
    cmd : TStringList;
    CancelSend : Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  // bSize - размер блока данных для передачи.
  // при большом блоке возможны потери пакетов
  // например, у меня при передаче файла более 100 Мб при размере блока 8000
  // файл доходил неполностью.
  bSize : Integer = 4000;
  // SleepTime - время задержки между отправкой очередного блока
  // при значении менее 3 бывают потери пакетов
  // чтобы такого не происходило, небоходимо дописывать функционал контроля
  // целостности блоков данных при отправке и получении
  SleepTime : ShortInt = 3;
  btnNameSend : string[4] = 'Send';
  btnNameCancel : string[6] = 'Cancel';

implementation

{$R *.dfm}

// процедура вывода журнала сообщений
procedure TForm1.Jornal(txt: string);
var
  time : string;
begin
if txt = '' then Exit;
time := '[' + DateTimeToStr(now) + '] ';
RxRichEdit1.Lines.Add(time+txt);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Active := True;
if ServerSocket1.Active then Jornal('Сервер запущен');
CancelSend := False;
btn1.Caption := btnNameSend;
end;

procedure TForm1.iniSaveTimer(Sender: TObject);
var F: TIniFile;
begin
  F := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'option\option.ini');
  F.WriteInteger('сервер','sendVal',sendVal.Value);
  F.Free;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i : Integer;
begin
// закрытие подключений клиентов
for i := ServerSocket1.Socket.ActiveConnections - 1 downto 0 do
        ServerSocket1.Socket.Connections[i].Close;
if ServerSocket1.Active then ServerSocket1.Active := False;
end;

//скрин экрана
procedure MakeScreenshot(bmp: TBitmap);
var
  vDesktopDC: HDC;
begin
  vDesktopDC := GetWindowDC(GetDesktopWindow);
  try
      bmp.PixelFormat := pf24bit;
      bmp.Height := Screen.Height;
      bmp.Width := Screen.Width;
      BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, vDesktopDC, 0, 0, SRCCOPY);
  finally
    ReleaseDC(GetDesktopWindow, vDesktopDC);
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  getfsize : TFileStream;
  JPEG: TJPEGImage;
  Bitmap: TBitmap;

begin
if ServerSocket1.Socket.ActiveConnections = 1 then
  begin
    if btn1.Caption = btnNameSend then
      begin
        JPEG := TJPEGImage.Create;
        Bitmap := TBitmap.Create;
        try
          MakeScreenshot(Bitmap);
          image1.Picture.Bitmap:=Bitmap;

          JPEG.Assign(Bitmap);
          if FileExists('1.jpg') then DeleteFile('1.jpg');
          JPEG.SaveToFile('1.jpg');
        finally
          JPEG.Free;
          Bitmap.Free;
        end;

        if FileExists(edt1.Text) then
            begin
              cmd.Clear;
              getfsize := TFileStream.Create(edt1.Text, fmOpenRead);
              cmd.Add(ExtractFileName(edt1.Text));
              cmd.Add(IntToStr(getfsize.Size));
              getfsize.Free;
              // уведомление клиента о передаче файла
              // отправляется имя и размер файла посредство размещения
              // данных в cmd (TStringList)
              ServerSocket1.Socket.Connections[0].SendText(cmd.Text);
            end;
      end
    else
      begin
         CancelSend := True;
         Jornal('Передача файла отменена пользователем');
      end;
  end;
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
// cmd можно создавать и в formcreate
cmd := TStringList.Create;
Jornal('> Клиент подключился: [' + Socket.RemoteAddress + ']');
btn1.Click;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
if Assigned(cmd) then cmd.Free;
Jornal('< Клиент отключился: [' + Socket.RemoteAddress + ']');
end;

//посылка файла через сокет [имя файла; позиция, с которой нужно начинать слать файл]
procedure TForm1.SendFileSocket(fName: string);
var
  nSend : Integer;
  sBuf : Pointer;
begin
try
    if CancelSend then Exit;
    btn1.Caption := btnNameCancel;
    nSend := 0;

    // открытие файла для чтения и последующей отправки
    fs := TFileStream.Create(edt1.Text, fmOpenRead);
    // курсор на начальную позицию, с которой нужно слать файл
    fs.Position := 0;

    // управление прогресс баром
    Progress(fs.Position, fs.Size);

    Jornal('Отправка файла ' + QuotedStr(ExtractFileName(edt1.Text)));
    Jornal('Размер файла ' + QuotedStr(IntToStr(fs.Size)));

    repeat
       // если нажата кнопка отмены, то выход
       if CancelSend then Break;
       // хватаем буфера (.)(.)
       GetMem(sBuf, bSize + 1);
       // чтение куска данных (bSize) из файла
       nSend := fs.Read(sBuf^, bSize);
       // если что то прочиталось, то отправляем клиенту
       if nSend > 0 then
         begin
           ServerSocket1.Socket.Connections[0].SendBuf(sBuf^, nSend);
           // корректировка значений прогрес бара
           Progress(fs.Position, fs.Size);
           // задержка иначе будут потери пакетов
           Sleep(SleepTime);
         end;
       // отпускаем буфера (.)(.)
       FreeMem(sBuf);
       Application.ProcessMessages;
    until nSend <= 0; // цикл выполняется пока хоть 1 байт будет прочитан из потока fs

    // если не нажата кнопка отмены, то файл отправлен
    if not CancelSend then begin sendVal.Value:=sendVal.Value+1; Jornal('Файл отправлен!'); timer1.Enabled:=true; end;
finally
    if Assigned(fs) then fs.Free;
    btn1.Caption := btnNameSend;
    if CancelSend then CancelSend := False;
end;
end;

// процедура управления прогресс баром
procedure TForm1.Progress(prg, maxprg: Integer);
begin
Gauge1.Progress := prg;
Gauge1.MaxValue := maxprg;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
    cmd.Text := Socket.ReceiveText;
    //клиент сообщил о готовности приёма файла fName
    if cmd.Strings[0] = 'send' then
      begin
         Jornal('Клиент [' + socket.RemoteAddress + '] готов принять файл ' + QuotedStr(cmd.Strings[1]));
         // отправка файла клиенту
         if (ExtractFileName(edt1.Text) = cmd.Strings[1]) then SendFileSocket(edt1.Text);
      end;
end;

//отправка скриншота каждые 2 сек
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  timer1.Enabled:=false;
  btn1.Click;
end;

//Пауза, МС
procedure TForm1.wait(interval: integer);
var time:Cardinal;
begin
  time:= GetTickCount + interval;
  while GetTickCount < time do
    begin
      sleep(50);
      application.ProcessMessages;
    end;
end;

end.

Если использовать TMemoryStream как узнать размер передаваемого скриншота не сохраняя его на диск?