Есть программа клиент сервер для передачи кадров с вебки по сети. В принципе работает изумительно. Исходники полностью скинуть не могу, только в личку. В общем суть проблемы.
Клиент
| Код |
procedure TForm1.TCPClient1Connected(Sender: TObject);
var
FileName, SizeFile, InCom, recv: string;
MemStream: TMemoryStream;
bm : TBitMap;
begin
while TCPClient1.Connected do
begin
{**********************************************************************************}
if StartedVideo = False then // если видео не стартовало
begin
TCPClient1.WriteLn('start'); // отправляем серверу команду start
TCPClient1.WriteInteger(CurrentCam); // отправляем серверу id камеры
recv := TCPClient1.Readln; // читаем ответ сервера
if recv = 'OK' then // если камера с этим id доступна
begin
StartedVideo := True; // начинаем принимать кадры
end
else// if recv = 'Cam not support' then
begin
StartedVideo := False;
TCPClient1.Disconnect;
Exit;
end;
end;
{**********************************************************************************}
TCPClient1.WriteLn(SIZE);
TCPClient1.WriteInteger(QUALITY);
TCPClient1.WriteInteger(FLIP);
TCPClient1.WriteInteger(SHARP);
InCom := TCPClient1.Readln;
if InCom = 'videostream sending' then
begin
FileName := TCPClient1.Readln;
SizeFile := TCPClient1.Readln;
MemStream := TMemoryStream.Create;
TCPClient1.ReadStream(MemStream, StrToInt(SizeFile));
try
MemStream.SaveToFile('.\temp\' + FileName);
Form2.Image1.Picture.LoadFromFile('.\temp\' + FileName);
except
end;
MemStream.Free;
//Form2.Caption := FileName;
//Application.ProcessMessages;
end
else if InCom = 'bye' then
begin
TCPClient1.Disconnect;
end;
end;
end;
|
Сервер
| Код |
function TForm1.StartVideo(Cam : Integer) : Boolean;
begin
try
begin
Form1.FilterGraph.ClearGraph;
Form1.FilterGraph.Active := false;
Form1.Filter.BaseFilter.Moniker := SysDev.GetMoniker(Cam);
Form1.FilterGraph.Active := true;
with Form1.FilterGraph as ICaptureGraphBuilder2 do
CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW , nil, Form1.Filter as IBaseFilter, nil, Form1.VideoWindow as IbaseFilter));
Form1.FilterGraph.Play;
CamOK := True;
Result := True;
end;
except
begin
CamOK := False;
Result := False;
end;
end;
end;
procedure TForm1.TCPServer1Execute(AThread: TIdPeerThread);
var
MemStream : TMemoryStream;
bmp, sbmp : Tbitmap;
FileName, size : String;
SizeFile, w, h, flip, quality, sharp, temp : integer;
jpg : TJpegImage;
begin
jpg := TJpegImage.Create;
bmp := TBitmap.Create;
MemStream := TMemoryStream.Create;
FileName := TCPServer1.LocalName+'.jpg';
if AThread.Connection.ReadLn = 'start' then // если получена команда start
begin
if VideoStarted = False then
begin
temp := AThread.Connection.ReadInteger; // читаем id камеры
if StartVideo(temp) = True then // если камера доступна
begin
VideoStarted := True;
AThread.Connection.Writeln('OK'); // отвечаем ОК
end
else
begin
AThread.Connection.Writeln('Cam not support'); // иначе отвечаем не ОК
end;
end;
end;
if CamOK = True then
SampleGrabber1.GetBitmap(bmp) // если доступна, то отправляем кадр
else
bmp.LoadFromResourceName(HInstance, 'BITMAP1'); // если нет, то отправляем картинку с перечеркнутой вебкой
size := AThread.Connection.ReadLn;
quality := AThread.Connection.ReadInteger;
w := StrToInt(Copy(size,1,3));
h := StrToInt(Copy(size,5,3));
sbmp:=Tbitmap.create;
sbmp.width:=w;
sbmp.Height:=h;
sbmp.pixelFormat:=pf24bit;
SetStretchBltMode(sbmp.canvas.handle,4);
StretchBlt(sbmp.canvas.handle,0,0,w,h,bmp.canvas.handle,
0,0,bmp.width,bmp.height,SRCCOPY);
flip := AThread.Connection.ReadInteger;
sharp := AThread.Connection.ReadInteger;
Image1.Picture.Assign(sbmp);
if sharp <> 0 then
BmpSharp(Image1.Picture.Bitmap, sharp);
if flip > 0 then
begin
Mirror(Image1.Picture, flip);
jpg.Assign(Image1.Picture.Bitmap);
jpg.CompressionQuality := quality;
jpg.PixelFormat := jf24Bit;
end
else if flip = 0 then
begin
jpg.Assign(Image1.Picture.Bitmap);
jpg.CompressionQuality := quality;
jpg.PixelFormat := jf24Bit;
end;
jpg.Compress;
jpg.SaveToStream(MemStream);
SizeFile:=MemStream.Size;
MemStream.Position:=0;
AThread.Connection.Writeln('videostream sending');
AThread.Connection.Writeln(FileName);
AThread.Connection.Writeln(IntToStr(SizeFile));
AThread.Connection.OpenWriteBuffer;
AThread.Connection.WriteStream(MemStream);
AThread.Connection.CloseWriteBuffer;
MemStream.Free;
bmp.Free;
sbmp.Free;
jpg.Free;
Form1.Caption := FileName+' (' + IntToStr(SizeFile) + ' bytes)';
end;
|
Так вот суть проблемы. Какой бы id я не отправил с клиента всегда приходит ответ Cam no support. Обе камеры доступны сто пудов. Я добавил на сервере две кнопки и щелчком вызываю StartVideo(0) и StartVideo(1). Все работает. Предполагаю, что ошибка в том месте, где сервер проверяет if StartVideo(temp) = True then // если камера доступна . Такое ощущение, что он не ждет ответа от функции, а продолжает работать дальше.
Я уже башку всю сломал. Помогите, пожалуйста. |
)