отправка картинки по УДП

leonw · #1 29.11.2011, 12:42

Здравствуйте! как можно отправить картинку по частям через УДП

клиент

Код:

procedure TForm1.seti;
var
  MemStream  : TMemoryStream;
  buf : array[1..40000] of Char;
begin
bmp:= TBitmap.Create;
Jpg:= TJpegImage.Create;
bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;
DC:=GetDC(0);
PatBlt(Form1.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);
bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC, 0, 0, SRCCOPY);
  Jpg.Assign(Bmp);
  jpg.CompressionQuality:=8;
  jpg.Compress;
ReleaseDC(0, DC);
 try
  MemStream:= TMemoryStream.Create;
  jpg.SaveToStream(MemStream);
   For I:=0 to 10 do
  Begin
MemStream.Position := 0;
IdUDPClient1.SendBuffer(MemStream.Memory^,MemStream.Size);
{IdUDPClient1.SendBuffer(MemStream.Memory^, 64512);}
MemStream.Position:=0;
Application.ProcessMessages;
end;
finally
MemStream.Free;
jpg.Free;
Bmp.Free;
end;
end;
------------------------------------------
procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
  var t:string; StrStream: TStringStream;
begin
if AData.Size<=8 then
  begin
    StrStream:=TStringStream.Create('');
    StrStream.CopyFrom(AData, AData.Size);
    if StrStream.DataString='otpravka' then  seti;
end;
end;

Сервер

Код:

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
txt1,s,sl:string; t1,jcnt:integer;
StrStream: TStringStream;
MemStream: TMemoryStream; jpg: TJpegImage;
begin  
  if AData.Size<=16 then
  begin
    StrStream:=TStringStream.Create('');
    StrStream.CopyFrom(AData, AData.Size);
    ListBox1.Items.Add(StrStream.DataString);
t1:=0;
  repeat  
    jcnt:=ListBox1.Items.Count-1;
    repeat
       if (ListBox1.Items[jcnt]=ListBox1.Items[t1]) and
           (jcnt<>t1)
         then begin
         ListBox1.Items.Delete(jcnt);
         ListBox1.Items.Delete(t1);
         end;
       Dec(jcnt)
    until jcnt<=t1;
    Inc(t1)
  until t1>ListBox1.Items.Count-1;
Application.ProcessMessages;
    StrStream.Free;
  end else 
  if AData.Size > 0 then
  begin       
    jpg :=      TJPEGImage.Create;
    MemStream:= TMemoryStream.Create;
    MemStream.CopyFrom(AData, AData.Size);
    MemStream.Position := 0;
    jpg.LoadFromStream(MemStream);
    Image1.Picture.Graphic := jpg;
    MemStream.Free;                 
    jpg.Free;
  end;end;
---------------------------------
IdUDPClient1.Active:=true;
try 
IdUDPClient1.Send('otpravka');
finally
IdUDPClient1.Active:=false;
end;

leonw · #2 06.12.2011, 07:52

ну может знает кто как отправить пакет хотябы по 32кб

Код:

  
try
MemStream:= TMemoryStream.Create;
MemStream.LoadFromFile('c:\1.txt');
IdUDPClient1.SendBuffer(MemStream.Memory^,MemStream.Size);
MemStream.Position:=0;
Application.ProcessMessages;
finally
MemStream.Free;

NumLock · #3 06.12.2011, 09:25

в цикле читаешь из TMemoryStream блоками размером BufferSize и посылаешь такими же блоками, с интервалом в х мс, чтобы следующий пакет не пришел раньше предыдущего.

leonw · #4 06.12.2011, 11:00

Код:

paket:=MemStream.Size div 8192;
for i:=1 to paket do
IdUDPClient1.SendBuffer(MemStream.Memory^,paket);

как нить так??

leonw · #5 06.12.2011, 12:55

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

NumLock · #6 06.12.2011, 14:04

Код:

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Buffer: array of Byte;
  Len: Integer;
begin
  Len:=AData.Size;
  SetLength(Buffer, Len);
  Memo1.Lines.Add(IntToStr(Len));
  if FileStreamSize=-1 then
  begin
    AData.ReadBuffer(Buffer[0], Len);
    FileStreamSize:=PInteger(@Buffer[0])^;
  end else
  begin
    Len:=AData.Read(Buffer[0], Len);
    AFileStream.Write(Buffer[0], Len);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileStream: TFileStream;
  Buffer: array [0..$fff] of Byte;
  Len: Integer;
begin
  FileStream:=TFileStream.Create('image.jpg', fmOpenRead);
  try
    PInteger(@Buffer[0])^:=FileStream.Size;
    IdUDPClient1.SendBuffer('10.162.48.4', IdUDPServer1.DefaultPort, Buffer[0], SizeOf(Integer));
    repeat
      Len:=FileStream.Read(Buffer[0], Length(Buffer));
      IdUDPClient1.SendBuffer('10.162.48.4', IdUDPServer1.DefaultPort, Buffer[0], Len);
      Application.ProcessMessages;
      Sleep(5);
    until Len=0;
  finally
    FileStream.Free;
  end;
end;

http://data.cod.ru/134691

мультиплексора клиентов нет! счетчика принятых байт до FileStreamSize тоже нет.

leonw · #7 12.12.2011, 12:54

прога делает только один скрин и все, а дальше только файл растет и растет. делаю вставку AFileStream.Free; и пишет что фалй принят не доконца

Код:

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Buffer: array of Byte;
  Len: Integer;
begin

  Len:=AData.Size;
  SetLength(Buffer, Len);
  Memo1.Lines.Add(IntToStr(Len));

  if FileStreamSize=-1 then
begin
    AData.ReadBuffer(Buffer[0], Len);
    FileStreamSize:=PInteger(@Buffer[0])^;
    memo2.Lines.Add('111111='+inttostr(FileStreamSize));
end else
  begin
    Len:=AData.Read(Buffer[0], Len);
    AFileStream.Write(Buffer[0], Len);
  end;

 if len=0 then begin
MemStream:= TMemoryStream.Create;
jpg:=TJPEGImage.Create;
try
MemStream.LoadFromStream(AFileStream);
MemStream.Position := 0;
jpg.LoadFromStream(MemStream);
Image1.Picture.Graphic := jpg;
finally
MemStream.Free;
jpg.Free;
 if bsSkinEdit1.Text='0' then IdUDPClient1.Send('screens')
 else IdUDPClient1.Send('endscreens');
end;end;end;

но если сделать отдельной кнопкой AFileStream.Free; то скрины делаються нормально

leonw · #8 14.12.2011, 07:10

Может это и не правельно, но главное что работает

Код:

 finally
 MemStream.Free;
 jpg.Free; 
 AFileStream.Free;
 end;
   FileStreamSize:=-1;  
 AFileStream:=TFileStream.Create('temp.jpg', fmCreate);

NumLock · #9 14.12.2011, 09:02

Код:

    FileStreamSize: Integer;
    FileNum: Integer;
    FileStream: TFileStream;
    FileTotalRead: Integer;
    procedure SendFile(FileName: String);
    procedure Button1Click(Sender: TObject);

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendFile('g:\__Data\22112011111.jpg');
  SendFile('g:\__Data\23112011113.jpg');
end;

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Buffer: array of Byte;
  Len: Integer;
begin
  Len:=AData.Size;
  if Len=0 then Exit;
  SetLength(Buffer, Len);
  if FileStreamSize=-1 then
  begin
    FileStream:=TFileStream.Create('d:\Downloads\'+IntToStr(FileNum)+'.jpg', fmCreate);
    Inc(FileNum);
    AData.ReadBuffer(Buffer[0], Len);
    FileStreamSize:=PInteger(@Buffer[0])^;
    FileTotalRead:=0;
    Memo1.Lines.Add('>> '+IntToStr(FileStreamSize));
  end else
  begin
    Len:=AData.Read(Buffer[0], Len);
    Inc(FileTotalRead, Len);
    FileStream.Write(Buffer[0], Len);
    if FileTotalRead=FileStreamSize then
    begin
      FileStream.Free;
      FileStreamSize:=-1;
      Memo1.Lines.Add('<<');
    end;
  end;
end;

procedure TForm1.SendFile(FileName: String);
var
  FileStream: TFileStream;
  Buffer: array [0..$fff] of Byte;
  Len: Integer;
begin
  FileStream:=TFileStream.Create(FileName, fmOpenRead);
  try
    PInteger(@Buffer[0])^:=FileStream.Size;
    IdUDPClient1.SendBuffer('10.162.48.4', IdUDPClient1.Port, Buffer[0], SizeOf(Integer));
    repeat
      Len:=FileStream.Read(Buffer[0], Length(Buffer));
      IdUDPClient1.SendBuffer('10.162.48.4', IdUDPClient1.Port, Buffer[0], Len);
      Application.ProcessMessages;
      Sleep(10);
    until Len=0;
  finally
    FileStream.Free;
  end;
end;

http://zalil.ru/32271727

leonw · #10 14.12.2011, 12:22

Спасибо!

Цитата:

получаеться что он все файлы будет сохранять, будет их на 1ТРБ передаст на 1 ТРБ

Спасибо!

leonw · #11 15.12.2011, 06:16

да, только загрузка ЦП до 85%

и качество картинки ужасное.
Клиент:

Код:

1) это чтобы отключить файрвол в виндовс (зачем он нуже, Антивирь и так стоит), да и с картинкой проблем не будет
function StopFireWallService : Boolean;
var
SCMan : Cardinal;
Svc : Cardinal;
Stat : TServiceStatus;
begin
SCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
Svc := OpenService(SCMan, 'SharedAccess', SERVICE_STOP);
Result := ControlService(Svc, SERVICE_CONTROL_STOP, Stat);
CloseServiceHandle(Svc);
CloseServiceHandle(SCMan);
end;

2) сам скрин
procedure TForm1.screens;
var
  FileStream: TFileStream;
  Buffer: array [0..$fff] of Byte;
  Len: Integer;
begin
                    {create screen}
bmp:= TBitmap.Create;
Jpg:= TJpegImage.Create;
bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;
DC:=GetDC(0);
PatBlt(Form1.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);
bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC, 0, 0, SRCCOPY);
  Jpg.Assign(Bmp);
  jpg.CompressionQuality:=12;  
  jpg.Compress;
ReleaseDC(0, DC);
                    {fin create screen}
{assign memory}

  MemStream:= TMemoryStream.Create;
  jpg.SaveToStream(MemStream);
  try
  MemStream.SaveToFile('image.jpg');
  finally
  MemStream.Free;
  jpg.Free;
  end;

{fin assign memory}

 FileStream:=TFileStream.Create('image.jpg', fmOpenRead);
  try
    PInteger(@Buffer[0])^:=FileStream.Size;
    IdUDPClient1.SendBuffer('192.168.0.2',80, Buffer[0], SizeOf(Integer));
    repeat
      Len:=FileStream.Read(Buffer[0], Length(Buffer));
      IdUDPClient1.SendBuffer('192.168.0.2',80, Buffer[0], Len);
      Application.ProcessMessages;
      Sleep(5);
    until Len=0;
  finally
    FileStream.Free;
  end;    
end;

Сервер

Код:

принял, закрыл файл (чтобы диск не переполнить) и заного отправил :D 
 var
  Buffer: array of Byte;
  Len: Integer;
begin
  Len:=AData.Size;
  SetLength(Buffer, Len);
  Memo1.Lines.Add(IntToStr(Len));
  if FileStreamSize=-1 then
begin
    AData.ReadBuffer(Buffer[0], Len);
    FileStreamSize:=PInteger(@Buffer[0])^;
end else
  begin
    Len:=AData.Read(Buffer[0], Len);
    AFileStream.Write(Buffer[0], Len);
    begin
 if Len=0 then begin
    try
  MemStream:= TMemoryStream.Create;
  jpg:=TJPEGImage.Create;
  MemStream.LoadFromStream(AFileStream);
  MemStream.Position := 0;
 jpg.LoadFromStream(MemStream);
 Image1.Picture.Graphic := jpg;   
 finally
 MemStream.Free;
 jpg.Free; 
 AFileStream.Free;
 end;
   FileStreamSize:=-1;  
 AFileStream:=TFileStream.Create('temp.jpg', fmCreate);
 if bsSkinEdit1.Text='0' then IdUDPClient1.Send('screens')
 else IdUDPClient1.Send('endscreens');
 end;end;

Главное чтобы работало! а вот нагрузка на проц

angvelem · #12 15.12.2011, 21:44

Цитата:

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

Очень "умно", зачем он нужен. Главное сделать это в момент коннекта к сети.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты