Передача картинки через Socket

← →
shadowonline © (2005-11-28 13:27) [0]

Есть отлаженный алгоритм, работает. Перенес его в сервис скомпилированный в DLL, наблюдается интересная картина.
Когда клиент и сервер находятся на одной машине все работает просто прекрасно, если сервер находится на другой машине то передача картинки вроде бы запускается (StatusBar немного изменяет свое значение и останавливается) но не заканчивается.
Что это может быть я не понимаю, где капать подскажите плииизззз!!!!!

Клиент

procedure TForm1.PixClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
var
st, sl,stPath: string;
temp:Boolean;
begin
st:= Socket.ReceiveText;
// Åñëè ìû íå â ðåæèìå ïðè¸ìà:
If not Reciving Then Begin
// Òåïåðü íàì íåîáõîäèìî ïîëó÷èòü äëèíó ïîòîêà äàííûõ.
SetLength(sl, StrLen(PChar(st))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(st), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
// Óäàëÿåì èíôîðìàöèþ î ðàçìåðå èç äàííûõ.
Delete(st, 1, Length(sl));
Reciving:= True;
ProgressBar1.Position:= 0;
ProgressBar1.Max:= DataSize;
End;
// Ñîõðàíÿåì äàííûå â ôàéë, äî òåõ ïîð, ïîêà íå ïîëó÷èì âñå äàííûå.
Try
Data.Write(st[1], LenGth(st));
ProgressBar1.Position:= Data.Size;
If Data.Size = DataSize Then Begin
// Try
Data.Position:= 0;
Image1.Picture.Bitmap.LoadFromStream(Data);

Data.Free;
Reciving:= False;
HorScrollBar.Max:= Image1.Width- TabSheet2.Width+13;
VertScrollBar.Max:= Image1.Height- TabSheet2.Height+13;
Image1.Left:= -HorScrollBar.Position;
Image1.Top:= -VertScrollBar.Position;

// Finally
GetScrButton.Enabled:= True;
ConnectButton.Enabled:= True;
ProgressBar1.Position:= 0;
// End;

End;

Except
Data.Free;
End;
end;

Сервер

procedure TWin32Service.PixServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
st:String;
ms: TMemoryStream;
begin
st:= Socket.ReceiveText;
If st= _GetScrKey Then Begin
GetScreen;//Снимает с экрана картинку в bmp1
ms:= TMemoryStream.Create;
Try
// Ïîëó÷àåì äàííûå íà ïåðåäà÷ó.

bmp1.SaveToStream(ms);
ms.Position:= 0;
// Äîáàâëÿåì äëèíó äàííûõ, ÷òîáû êëèåíò çíàë,
// ñêîëüêî äàííûõ áóäåò ïåðåäàíî
// Äîáàâëÿåì #0 , ÷òîáû ìîæíî áûëî îïðåäåëèòü,
// ãäå çàêàí÷èâàåòñÿ èíôîðìàöèÿ î ðàçìåðå.
PixServerSocket.Socket.Connections[0].SendText(IntToStr(ms.Size) + #0);
// Ïîñûëàåì åãî.
PixServerSocket.Socket.Connections[0].SendStream(ms);
Finally
// Èòàê, îñòàëîñü îñâîáîäèòü ïîòîê, åñëè ÷òî-òî íå òàê.
ms.Free;
end;
end;
end;

shadowonline@mail.ru

← →
Digitman © (2005-11-28 15:12) [1]

"сервис скомпилированный в DLL" - это как ?

убери комментарии (либо повтори свой пост с кириллицей) - читать эту хрень нет желания

← →
Slym © (2005-11-29 05:15) [2]

Когда сервер и клиент на одном хосте, они общаются по LOOPBACK интерфейсу MTU которой до 65536... + все переданные данные возможно даже не покидают оперативку и возможность блокировки сокета минимальна и данные МОГУТ БЫТЬ ПРОЧИТАНЫ ЗА 1 PixClientSocketRead

На разных компах MTU 1500+ передача по разделяемой среде и вероятность блокировки сокета много превосходит LOOPBACK и данные МОГУТ БЫТЬ НЕПРОЧИТАНЫ ЗА 1 PixClientSocketRead
т.е. придет только часть данных, и эти части нужно накопить перед их обработкой

← →
shadowonline © (2005-11-29 07:39) [3]

Использован алгоритм с http://delphid.dax.ru/docs/view/socket.htm.
Счетчик на клиенте при локальной передаче картинки показывает 64-68 проходов PixClientSocketRead. Та же история с компонентами TNMStrm, локально работают а по сетке нет. Мистика!!!!
Этот же алгоритм в обычной программе без проблем передает 5М BMP, а в сервисе даже 200кб jpg передать не может. Причем текст через сокет передается.

← →
Slym © (2005-11-29 07:52) [4]

После длительного анализа кода...
Да накапливаешь данные перед обработкой- похвально, но зачем настолько криво?

PixServerSocket.Socket.Connections[0].SendText
Ты уверен что ты первый у сервера?

А копать нужно в обработке остальных Event-ов не только Read бывает

← →
shadowonline © (2005-11-29 07:56) [5]

Вот код функций без коментариев

Сервер

procedure TWin32Service.PixServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
st:String;
ms: TMemoryStream;
begin
st:= Socket.ReceiveText;
If st= _GetScrKey Then Begin
GetScreen;
ms:= TMemoryStream.Create;
Try
jpg2.SaveToStream(ms);
ms.Position:= 0;
PixServerSocket.Socket.Connections[0].SendText(IntToStr(ms.Size) + #0);
PixServerSocket.Socket.Connections[0].SendStream(ms);
Finally
ms.Free;
end;
end;
end;

Клиент

procedure TForm1.PixClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
var
st, sl,stPath: string;
temp:Boolean;
begin
st:= Socket.ReceiveText;
If not Reciving Then Begin
SetLength(sl, StrLen(PChar(st))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(st), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
Delete(st, 1, Length(sl));
Reciving:= True;
ProgressBar1.Position:= 0;
ProgressBar1.Max:= DataSize;
idI:= 0;
End;

Try
Data.Write(st[1], LenGth(st));
ProgressBar1.Position:= Data.Size;
Inc(idI);
If Data.Size = DataSize Then Begin
Try
Data.Position:= 0;
jpg2.LoadFromStream(Data);
stPath:= ExtractFilePath(ParamStr(0))+"pix.jpg";
jpg2.SaveToFile(stPath);
Image1.Picture.Graphic := nil;
Temp := Image1.Picture.Graphic is TJPEGImage;
If Temp Then
With TJPEGImage(Image1.Picture.Graphic) Do Begin
PixelFormat:= TJPEGPixelFormat(0);//24 bit
Scale:= TJPEGScale(0); //1:1
Grayscale:= Boolean(0);//RGB
Performance:= TJPEGPerformance(0);//Quality
ProgressiveDisplay:= False;
end;
Image1.IncrementalDisplay := False;
Image1.Picture.LoadFromFile(stPath);
jpg2.Free;
jpg2 := TJpegImage.Create;
Data.Free;
Reciving:= False;
HorScrollBar.Max:= Image1.Width- TabSheet2.Width+13;
VertScrollBar.Max:= Image1.Height- TabSheet2.Height+13;
Image1.Left:= -HorScrollBar.Position;
Image1.Top:= -VertScrollBar.Position;
ShowMessage(IntToStr(idI));
Finally
GetScrButton.Enabled:= True;
ConnectButton.Enabled:= True;
ProgressBar1.Position:= 0;
End;
End;
Except
Data.Free;
End;
end;

← →
shadowonline © (2005-11-29 07:59) [6]

> PixServerSocket.Socket.Connections[0].SendText
> Ты уверен что ты первый у сервера?
Изначально задумано что соединение 1.
> А копать нужно в обработке остальных Event-ов не только
> Read бывает

Кроме рида обработок больше нет.
Интересней почему в обычной программе этот код работает.

← →
Digitman © (2005-11-29 08:30) [7]

> Интересней почему в обычной программе этот код работает

сервис исполняется в контексте доп.код.потока, это весьма важный момент

← →
shadowonline © (2005-11-29 08:48) [8]

Перенес приобразованный алгоритм на старую прогу не работает(все также).
Напрашивается вывод что проблемма в тех изменениях которые я сделал.
Код старого алгоритма:

Сервер

procedure TForm1.PixServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
Var
st:String;
ms: TMemoryStream;
begin
st:= Socket.ReceiveText;
If st= _GetScrKey Then Begin
GetScreen();
ms:= TMemoryStream.Create;
Try
Image1.Picture.Bitmap.SaveToStream(ms);
ms.Position:= 0;
PixServerSocket.Socket.Connections[0].SendText(IntToStr(ms.Size) + #0);
PixServerSocket.Socket.Connections[0].SendStream(ms);
Except
ms.Free;
End;
End;
end;

Клиент

procedure TForm1.PixClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
var
st, sl: string;

begin
st:= Socket.ReceiveText;
If not Reciving Then Begin
SetLength(sl, StrLen(PChar(st))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(st), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
Delete(st, 1, Length(sl));
Reciving:= True;
ProgressBar1.Position:= 0;
ProgressBar1.Max:= DataSize;
End;

Try
Data.Write(st[1], LenGth(st));
ProgressBar1.Position:= Data.Size;
If Data.Size = DataSize Then Begin
Data.Position:= 0;
Image1.Picture.Bitmap.LoadFromStream(Data);
Data.Free;
Reciving:= False;
HorScrollBar.Max:= Image1.Width- TabSheet2.Width+13;
VertScrollBar.Max:= Image1.Height- TabSheet2.Height+13;
Image1.Left:= -HorScrollBar.Position;
Image1.Top:= -VertScrollBar.Position;
GetScrButton.Enabled:= True;
ConnectButton.Enabled:= True;
ProgressBar1.Position:= 0;
End;
Except
Data.Free;
End;
end;

Отличия в том что:
Вместо TImage используется TBitmap
Конвертируется в TJpegImage и только потом отправляется.
Проверенно отправка картинки из TBitmap тоже не проходит.
Процедура снятия экрана:
Старая

procedure TForm1.GetScreen();
var
BMFI: TBitMap;
Clipboard:TClipboard;
begin
BMFI:=TBitMap.Create;
Clipboard:= TClipboard.Create;
Try
BMFI.Width := Screen.Width;
BMFI.Height := Screen.Height;
BitBlt(BMFI.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
GetDC(GetDesktopWindow), 0, 0, SRCCopy);
Clipboard.Assign(BMFI);
Finally
BMFI.Free;
End;
Image1.Picture:= TPicture(Clipboard);

Clipboard.Free;

end;

Новая

procedure TWin32Service.GetScreen;
begin
Try
bmp1.Height := ScreenHeight;
bmp1.Width := ScreenWidth;
ScreenDC:=GetDC(GetDesktopWindow);
BitBlt(bmp1.Canvas.Handle, 0, 0, ScreenWidth, ScreenHeight, ScreenDC , 0, 0, SRCCopy);
jpg2.Assign(bmp1);
bmp1.FreeImage;
jpg2.Grayscale := False;
jpg2.CompressionQuality:= 75;
jpg2.Performance := jpBestQuality;
jpg2.ProgressiveDisplay := False;
jpg2.PixelFormat := jf24Bit;
jpg2.Compress;
Finally
ReleaseDC(0,ScreenDC);
End;
end;

← →
Verg © (2005-11-29 08:49) [9]

Первое что "режет глаз":

PixServerSocket.Socket.Connections[0].SendStream(ms); Finally ms.Free;

А теперь читаем Help:

Note: The Stream passed as a parameter to SendStream becomes “owned” by the windows socket object. The Windows socket object frees the stream when it is finished with it. Do not attempt to free the stream after it has been passed as a parameter.

← →
Digitman © (2005-11-29 09:16) [10]

> shadowonline © (29.11.05 08:48) [8]

в условиях глоб.сети код передающей стороны работать как положено не будет, ВНЕ зависимости от того, где он используется - в сервисе или не в сервисе.

в асинхронном неблок.режиме вызовы функциональных Send-методов должны сопровождаться обязательным анализом возвращаемых ими результатов ... от этих результатов зависит вся логика передающего алгоритма, который обязательно должен обрабатывать OnWrite-событие, извещающее о факте освобождения буфера передачи, размер которого фиксирован и по умолчанию равен 8 КБайт

Есть!!!!!!!! Пасибо большое за помощь!!!!!!!!!! Осталось определится где поток создавать и разрушать. Хотя я просто убрал ms.Free; и заработало!!!!!
Всем большое спасибо за помощь!!!!!!!!!!!!!
Быстрый скриншот по сетке это круто!!!!

> где поток создавать и разрушать

в [8] ты и так уже убрал ms.Free из finally

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

← →
VoLTeC (2006-02-03 13:42) [13]

вот 100 % работающий алгоритм

СЕРВЕР

.......
ms:=TMemoryStream.Create; //Создаю поток
jpg:=TJPEGIMAGE.Create;
bmp:=TBitmap.Create;
try
bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;
DC:=GetDC(0);
bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DC, 0, 0, SRCCOPY);
jpg.CompressionQuality:=40
JPG.Compress;
jpg.Assign(bmp);
jpg.SaveToStream(ms);
Socket.SendText("size!?!"+inttostr(ms.Size)+#0);
ms.Position:=0; // это очень важно!!!!!!
Socket.SendStream(ms);
finally
bmp.Free;
jpg.Free;
end;
.............

КЛИЕНТ

............
if Reciving then
begin
ms.Write(s[1], length(s));
if ms.Size=DataSize then
begin
Reciving:=false;
ms.Position:=0; // это очень важно!!!!!!
JPG.LoadFromStream(ms);
Form2.Image1.Picture.Bitmap.Assign(jpg);
ms.Free;
Form2.Visible:=true;
end;
exit;
end;
if (c="size")and(p<>"OK"#$D#$A) then
begin
DataSize:=StrToInt(p);
Delete(s, 1, Pos(p+#0, s)+Length(p)+1);
Reciving:=true;
ms:=TMemoryStream.Create;
ms.Position:=0;
ms.Write(s[1],length(s))
end;
..........................

Удачи юнный кулхацкеры =)

> VoLTeC (03.02.06 13:42) [13]
> вот 100 % работающий алгоритм

До "ста процентов" твоему алгоритму - как до китая раком.

> юнный

Учити русский до полного просветления !

← →
ctapyxa (2006-03-14 21:13) [15]

ни черта не понял=)))))

VoLTeC - ни черта не работает=D а вот то что было выше усё пашет=)))

Передача картинки через Socket Найти похожие ветки