文档作者:陈经韬
本文主要讲述视频数据获取、保存为mpeg、调用Mpeg4压缩算法、自己用Delphi写编解码器和如何防范Usb偷窥。
一:获取摄像头数据
获取数据可以使用Directx或Vfw接口。一般来说,Directx比较占用cpu,而且com接口是比较麻烦的,所以一般使用vfw。不过,如果想直接捕获视频和声音保存为wmv文件,那么就要使用Directx。我们这里先讲vfw的。
1:Vcl法:到网上搜索VideoCap控件,拖放到窗口即可。
2:API法:网上已经有很多相关介绍了,这里还是重复一下:
下面给出一个简单的例子,主要完成数据捕获和压缩。同时为了趣味性,还加上字幕功能。
添加单元vfw.pas,同时本例子还用到jpeg压缩,所以还要添加jpeg单元。完整代码如下(注意:代码没有做过多容错处理,请自行完善):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, {} vfw, Jpeg, {} Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TFrmMain = class(TForm)
Button1: TButton;
Panel1: TPanel;
Image1: TImage;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
CaptureHandle: THandle;
BmpInfo: TBitmapInfo;
procedure CompareFrame(lpVHdr: PVIDEOHDR);
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
{$R *.dfm}
procedure TFrmMain.FormCreate(Sender: TObject);
begin
CaptureHandle := 0;
end;
procedure GetUsbCamerBmpSize(var BmpInfoHeader: TBitmapinfoheader);
var
PBmpInfoHeader: PBitmapInfo;
dwSize: DWORD;
begin
dwSize := capGetVideoFormatSize(FrmMain.CaptureHandle);
PBmpInfoHeader := GlobalAllocPtr(GHND, dwSize);
capGetVideoFormat(FrmMain.CaptureHandle, PBmpInfoHeader, dwSize);
CopyMemory(@BmpInfoHeader, @PBmpInfoHeader.bmiHeader, Sizeof(TBitmapinfoheader));
GlobalFreePtr(PBmpInfoHeader);
end;
procedure TFrmMain.CompareFrame(lpVHdr: PVIDEOHDR);
var
BmpFileHeader: TBitmapFileHeader;
BmpInfoHeader: TBitmapInfoHeader;
MyMemoryStream: TMemoryStream;
MyBmp: TBitmap;
MyJpg: TJPEGImage;
begin
{注意:实际上,lpVHdr里面已经包含有图像的裸数据了.可以直接Draw显示出来了.
这里因为需要添加字幕,同时转化为Jpeg格式.所以我们为裸数据加上Bmp文件头和
结构.
}
FillChar(BmpFileHeader, Sizeof(TBitmapfileheader), 0);
FillChar(BmpInfoHeader, Sizeof(TBitmapinfoheader), 0);
BmpFileHeader.bfType := $4D42; //文件类型,必须为BM.
BmpFileHeader.bfSize := BmpInfo.bmiHeader.biSizeImage; //BMP数据的大小字节
BmpFileHeader.bfReserved1 := 0; //保留,必需为0
BmpFileHeader.bfReserved2 := 0; //保留,必需为0
BmpFileHeader.bfOffBits := Sizeof(TBitmapFileHeader) + Sizeof(TBitmapInfoHeader); //Specifies the offset, in bytes, from the BITMAPFILEHEADER structure to the bitmap bits.
GetUsbCamerBmpSize(BmpInfoHeader);
Panel1.Left := 0;
Panel1.Top := 0;
Panel1.ClientWidth := BmpInfoHeader.biWidth;
Panel1.ClientHeight := BmpInfoHeader.biHeight;
MyBmp := TBitmap.Create;
MyJpg := TJPEGImage.Create;
MyMemoryStream := TMemoryStream.Create;
MyMemoryStream.Write(BmpFileHeader, sizeof(BmpFileHeader));
MyMemoryStream.Write(BmpInfoHeader, sizeof(BmpInfoHeader));
MyMemoryStream.Write(lpVHdr^.lpData^, BmpInfo.bmiHeader.biSizeImage);
MyMemoryStream.Position := 0;
MyBmp.LoadFromStream(MyMemoryStream);
with MyBmp.Canvas do
begin
Brush.style := bsClear; //先这样设置
Font.Color := clRed; // 文字前景色
Font.Size := 20; //TxtFont.Size;//10;//Self.Font.Size;
//Font.Name := Self.Font.Name;
TextOut(0, 0, DateTimeToStr(Now)); //else
//if RadioButton3.Checked then TextOut(0,0,Edit1.Text);
end;
Image1.Picture.Bitmap.Assign(MyBmp);
MyJpg.Assign(MyBmp);
MyJpg.CompressionQuality := 65;
MyMemoryStream.Clear;
MyJpg.SaveToStream(MyMemoryStream);
MyMemoryStream.Position := 0;
//SendVideoBufToClient(MyMemoryStream);//发送数据出去
MyMemoryStream.Free;
MyBmp.Free;
MyJpg.Free;
end;
function FrameCallBack(hWnd: HWND; lpVHdr: PVIDEOHDR): DWORD; stdcall;
begin
FrmMain.CompareFrame(lpVHdr);
Result := DWORD(True);
end;
procedure TFrmMain.Button1Click(Sender: TObject);
var
CapParms: TCAPTUREPARMS;
begin
//定义视频输入格式
FillChar(BmpInfo.bmiHeader, SizeOf(TBitmapInfoHeader), 0);
with BmpInfo.bmiHeader do
begin
biBitCount := 24;
biClrImportant := 0;
biClrUsed := 0;
biCompression := BI_RGB;
biHeight := 240;
biPlanes := 1;
biSize := SizeOf(TBitmapInfoHeader);
biSizeImage := 0;
biWidth := 320;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
end;
CaptureHandle := capCreateCaptureWindow('Capture Window',
WS_VISIBLE or WS_CHILD, 0, 0, 320, 240, Handle, 0); //创建一个AVICap捕获窗口
if CaptureHandle = 0 then
begin
ShowMessage('创建窗口失败!');
Exit;
end;
if not capDriverConnect(CaptureHandle, 0) then //连接摄像头.0代表第一个摄像头
begin
ShowMessage('打开摄像头失败!');
Exit;
end;
capSetVideoFormat(CaptureHandle, @BmpInfo, SizeOf(BmpInfo)); //设置视频格式
capPreviewRate(CaptureHandle, 15); //设置预览视频的频率
capSetCallbackOnVideoStream(CaptureHandle, @FrameCallBack); //设置回调函数.流格式.
//capSetCallbackOnFrame(CaptureHandle, @FrameCallBack);//帧格式
capCaptureGetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //获取当前设置
CapParms.fYield := TRUE;
CapParms.fAbortLeftMouse := FALSE;
CapParms.fAbortRightMouse := FALSE;
capCaptureSetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //改变需要改变的参数
capCaptureSequenceNoFile(CaptureHandle); //不保存文件
end;
procedure TFrmMain.Button2Click(Sender: TObject);
begin
if CaptureHandle <> 0 then
begin
CapCaptureStop(CaptureHandle); //停止捕获
//capSetCallbackOnFrame(CaptureHandle,nil);
capDriverDisconnect(CaptureHandle); //断开连接
end;
end;
end.
二:发送和保存
现在我们简单修改一下第一章节的程序,让它可以发送捕获的数据,接收端可以保存为mpeg文件.为了方便,网络部分我们直接使用Delphi自带的Indy.数据保存部分,可以使用Directx接口.我们这里使用了一个mpeg的代码.购买该代码可以打开http://www.msbsoftware.it/mpegpas/.我们来看修改后的发送端代码.
unit Unit_Send;
interface
uses
Windows, Messages, SysUtils, {} vfw, Jpeg, {} Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IdAntiFreezeBase, IdAntiFreeze,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;
type
TFrmMain = class(TForm)
btnStart: TButton;
Panel1: TPanel;
Image1: TImage;
btnStop: TButton;
Label1: TLabel;
Edit1: TEdit;
IdTCPClient1: TIdTCPClient;
IdAntiFreeze1: TIdAntiFreeze;
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
CaptureHandle: THandle;
BmpInfo: TBitmapInfo;
procedure CompareFrame(lpVHdr: PVIDEOHDR);
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
{$R *.dfm}
procedure TFrmMain.FormCreate(Sender: TObject);
begin
CaptureHandle := 0;
btnStart.Enabled := True;
btnStop.Enabled := False;
end;
procedure GetUsbCamerBmpSize(var BmpInfoHeader: TBitmapinfoheader);
var
PBmpInfoHeader: PBitmapInfo;
dwSize: DWORD;
begin
dwSize := capGetVideoFormatSize(FrmMain.CaptureHandle);
PBmpInfoHeader := GlobalAllocPtr(GHND, dwSize);
capGetVideoFormat(FrmMain.CaptureHandle, PBmpInfoHeader, dwSize);
CopyMemory(@BmpInfoHeader, @PBmpInfoHeader.bmiHeader, Sizeof(TBitmapinfoheader));
GlobalFreePtr(PBmpInfoHeader);
end;
function ChangeBmp(var MyBmp: TBitmap): Boolean; {动态改变BMP图像大小}
var
TempBitmap: TBitmap;
begin
TempBitmap := TBitmap.Create;
TempBitmap.Assign(MyBmp);
MyBmp.Width := 160; //176
MyBmp.Height := 120; //144
MyBmp.PixelFormat := pf15bit;
SetStretchBltMode(MyBmp.Canvas.Handle, COLORONCOLOR);
stretchblt(MyBmp.Canvas.Handle, 0, 0, MyBmp.Width, MyBmp.Height, TempBitmap.Canvas.Handle, 0, 0, TempBitmap.Width, TempBitmap.Height, srccopy);
TempBitmap.Free;
Result := True;
end;
procedure TFrmMain.CompareFrame(lpVHdr: PVIDEOHDR);
var
BmpFileHeader: TBitmapFileHeader;
BmpInfoHeader: TBitmapInfoHeader;
MyMemoryStream: TMemoryStream;
MyBmp: TBitmap;
MyJpg: TJPEGImage;
begin
{注意:实际上,lpVHdr里面已经包含有图像的裸数据了.可以直接Draw显示出来了.
这里因为需要添加字幕,同时转化为Jpeg格式.所以我们为裸数据加上Bmp文件头和
结构.
}
FillChar(BmpFileHeader, Sizeof(TBitmapfileheader), 0);
FillChar(BmpInfoHeader, Sizeof(TBitmapinfoheader), 0);
BmpFileHeader.bfType := $4D42; //文件类型,必须为BM.
BmpFileHeader.bfSize := BmpInfo.bmiHeader.biSizeImage; //BMP数据的大小字节
BmpFileHeader.bfReserved1 := 0; //保留,必需为0
BmpFileHeader.bfReserved2 := 0; //保留,必需为0
BmpFileHeader.bfOffBits := Sizeof(TBitmapFileHeader) + Sizeof(TBitmapInfoHeader); //Specifies the offset, in bytes, from the BITMAPFILEHEADER structure to the bitmap bits.
GetUsbCamerBmpSize(BmpInfoHeader);
Panel1.Left := 0;
Panel1.Top := 0;
Panel1.ClientWidth := BmpInfoHeader.biWidth;
Panel1.ClientHeight := BmpInfoHeader.biHeight;
MyBmp := TBitmap.Create;
MyJpg := TJPEGImage.Create;
MyMemoryStream := TMemoryStream.Create;
MyMemoryStream.Write(BmpFileHeader, sizeof(BmpFileHeader));
MyMemoryStream.Write(BmpInfoHeader, sizeof(BmpInfoHeader));
MyMemoryStream.Write(lpVHdr^.lpData^, BmpInfo.bmiHeader.biSizeImage);
MyMemoryStream.Position := 0;
MyBmp.LoadFromStream(MyMemoryStream);
with MyBmp.Canvas do
begin
Brush.style := bsClear; //先这样设置
Font.Color := clRed; // 文字前景色
Font.Size := 20; //TxtFont.Size;//10;//Self.Font.Size;
//Font.Name := Self.Font.Name;
TextOut(0, 0, DateTimeToStr(Now)); //else
//if RadioButton3.Checked then TextOut(0,0,Edit1.Text);
end;
ChangeBmp(MyBmp); //因为接收方的mpeg固定为此大小.所以必须改变它.当然,也可以先发送大小过去动态设置,则可省略此步.
Image1.Picture.Bitmap.Assign(MyBmp);
MyJpg.Assign(MyBmp);
MyJpg.CompressionQuality := 65;
MyMemoryStream.Clear;
MyJpg.SaveToStream(MyMemoryStream);
MyMemoryStream.Position := 0;
//发送数据出去
try
IdTCPClient1.WriteInteger(MyMemoryStream.Size);
IdTCPClient1.WriteStream(MyMemoryStream);
except
btnStop.Click;
MyMemoryStream.Free;
MyBmp.Free;
MyJpg.Free;
ShowMessage('发送失败');
Exit;
end;
MyMemoryStream.Free;
MyBmp.Free;
MyJpg.Free;
end;
function FrameCallBack(hWnd: HWND; lpVHdr: PVIDEOHDR): DWORD; stdcall;
begin
FrmMain.CompareFrame(lpVHdr);
Result := DWORD(True);
end;
procedure TFrmMain.btnStartClick(Sender: TObject);
var
CapParms: TCAPTUREPARMS;
begin
(Sender as TButton).Enabled := False;
IdTCPClient1.Host := Trim(Edit1.Text);
IdTCPClient1.Port := 2000;
try
IdTCPClient1.Connect(1000 * 10);
except
ShowMessage('连接失败!');
(Sender as TButton).Enabled := True;
Exit;
end;
//定义视频输入格式
FillChar(BmpInfo.bmiHeader, SizeOf(TBitmapInfoHeader), 0);
with BmpInfo.bmiHeader do
begin
biBitCount := 24;
biClrImportant := 0;
biClrUsed := 0;
biCompression := BI_RGB;
biHeight := 240;
biPlanes := 1;
biSize := SizeOf(TBitmapInfoHeader);
biSizeImage := 0;
biWidth := 320;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
end;
CaptureHandle := capCreateCaptureWindow('Capture Window',
WS_VISIBLE or WS_CHILD, 0, 0, 320, 240, Handle, 0); //创建一个AVICap捕获窗口
if CaptureHandle = 0 then
begin
ShowMessage('创建窗口失败!');
(Sender as TButton).Enabled := True;
Exit;
end;
if not capDriverConnect(CaptureHandle, 0) then //连接摄像头.0代表第一个摄像头
begin
ShowMessage('打开摄像头失败!');
(Sender as TButton).Enabled := True;
Exit;
end;
capSetVideoFormat(CaptureHandle, @BmpInfo, SizeOf(BmpInfo)); //设置视频格式
capPreviewRate(CaptureHandle, 15); //设置预览视频的频率
capSetCallbackOnVideoStream(CaptureHandle, @FrameCallBack); //设置回调函数.流格式.
//capSetCallbackOnFrame(CaptureHandle, @FrameCallBack);//帧格式
capCaptureGetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //获取当前设置
CapParms.fYield := TRUE;
CapParms.fAbortLeftMouse := FALSE;
CapParms.fAbortRightMouse := FALSE;
capCaptureSetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //改变需要改变的参数
capCaptureSequenceNoFile(CaptureHandle); //不保存文件
btnStop.Enabled := True;
end;
procedure TFrmMain.btnStopClick(Sender: TObject);
begin
(Sender as TButton).Enabled := False;
if CaptureHandle <> 0 then
begin
CapCaptureStop(CaptureHandle); //停止捕获
//capSetCallbackOnFrame(CaptureHandle,nil);
capDriverDisconnect(CaptureHandle); //断开连接
end;
if IdTCPClient1.Connected then IdTCPClient1.Disconnect;
end;
end.
接收端代码:
unit Unit_Recv;
interface
uses
Windows, Messages, SysUtils, {} mpeg, jpeg, {} Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdThreadMgr,
IdThreadMgrDefault, IdAntiFreezeBase, IdAntiFreeze, ExtCtrls, StdCtrls;
type
TFrmMain = class(TForm)
IdTCPServer1: TIdTCPServer;
btnStart: TButton;
CheckBox1: TCheckBox;
Panel3: TPanel;
Image1: TImage;
IdAntiFreeze1: TIdAntiFreeze;
IdThreadMgrDefault1: TIdThreadMgrDefault;
btnStop: TButton;
procedure btnStartClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
private
{ Private declarations }
MyMpeg: TMpeg;
fs: TFileStream;
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
{$R *.dfm}
procedure TFrmMain.FormCreate(Sender: TObject);
begin
CheckBox1.Checked := True;
btnStart.Enabled := True;
btnStop.Enabled := False;
MyMpeg := nil;
fs := nil;
end;
procedure TFrmMain.btnStartClick(Sender: TObject);
var
m_FileName: string;
begin
(Sender as TButton).Enabled := False;
try
IdTCPServer1.DefaultPort := 2000;
IdTCPServer1.Active := True;
except
ShowMessage('打开监听端口失败!');
(Sender as TButton).Enabled := True;
Exit;
end;
CheckBox1.Enabled := False;
if CheckBox1.Checked then
begin
m_FileName := ExtractFilePath(Application.ExeName) + 'Demo.mpeg';
MyMpeg := TMpeg.Create;
fs := TFileStream.Create(m_FileName, fmCreate or fmOpenReadWrite or fmShareDenyNone);
MyMpeg.Open(160, 120, 4, 2000, bf24hz, fs);
end;
btnStop.Enabled := True;
end;
procedure TFrmMain.btnStopClick(Sender: TObject);
begin
(Sender as TButton).Enabled := False;
if MyMpeg <> nil then MyMpeg.Free;
if fs <> nil then fs.Free;
end;
procedure TFrmMain.IdTCPServer1Execute(AThread: TIdPeerThread);
var
iSize: integer;
MyStream: TMemoryStream;
MyBmp: TBitmap;
MyJpg: TJPEGImage;
begin
try
iSize := AThread.Connection.ReadInteger;
except
Exit;
end;
MyStream := TMemoryStream.Create;
try
AThread.Connection.ReadStream(MyStream, iSize);
except
MyStream.Free;
Exit;
end;
MyStream.Position := 0;
MyBmp := TBitmap.Create;
MyJpg := TJPEGImage.Create;
MyJpg.LoadFromStream(MyStream);
MyBmp.Assign(MyJpg);
if CheckBox1.Checked then
begin
MyMpeg.AddIImage(MyBmp);
MyMpeg.Keep(2);
end;
Image1.Picture.Bitmap.Assign(MyBmp);
MyStream.Free;
MyJpg.Free;
MyBmp.Free;
end;
end.
完整代码点这里下载.