超级解霸是如何实现视频广播的???? 超级解霸中实现的视频广播很棒的,我想在自己的程序中实现这样的功能,不知道如何实现???另外我想知道如何在局域网中实现分组播放???? 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 一段源码:program Client;uses Forms, Main in 'Main.pas' {ClientForm}, VFW in '..\VFW.pas', VideoConsts in '..\VideoConsts.pas';{$R *.res}begin Application.Initialize; Application.CreateForm(TClientForm, ClientForm); Application.Run;end.//Client main.pasunit Main;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ScktComp, VideoConsts, VFW, StdCtrls, ExtCtrls;type TClientForm = class(TForm) Image1: TImage; ClientSocket1: TClientSocket; edIPAddr: TEdit; btnConnect: TButton; mmReport: TMemo; procedure btnConnectClick(Sender: TObject); procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Connecting(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket); private { 接收头信息, 一连接后,服务端发送头信息TServerControlInfo(two times), 之后是_VEDEO_DATA数据 } FRecvHeaderTimes: Byte; FCV: TCOMPVARS; FOutBuf: PByte; FOutBufSize: DWORD; FInInfo: TBitmapInfo; FOutInfo: TBitmapInfo; FOutFormatSize: DWORD; {$HINTS OFF} procedure ShowImage(Buf: PByte); {$HINTS ON} procedure ExecuteServerCommand(msg: TServerControlInfo); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end;var ClientForm: TClientForm;implementation{$R *.dfm}procedure TClientForm.ExecuteServerCommand(msg: TServerControlInfo);var Cmd: string;{ RetVal: Integer; hPalette: THandle;}begin Cmd := msg.strCommand; if SameText(Cmd, 'Set Bitmap Info') then begin Move(msg.strContent, FInInfo, SizeOf(FInInfo)); mmReport.Lines.Add(Format('FInInfo.bmiHeader .biHeight:%d, .biBitCount:%d', [FInInfo.bmiHeader.biHeight, FInInfo.bmiHeader.biBitCount])); end else if SameText(Cmd, 'Set COMPVARS') then begin Move(msg.strContent, FCV, SizeOf(FCV)); mmReport.Lines.Add(FOrmat('FCV.cbSize: %d', [FCV.cbSize])); //FCV.hic := ICDrawOpen(FCV.fccType, FCV.fccHandler, @FInInfo.bmiHeader); FCV.hic := ICOpen(FCV.fccType, FCV.fccHandler, ICMODE_DECOMPRESS); if FCV.hic = 0 then begin mmReport.Lines.Add(Format('FCV.fccType: %d', [FCV.fccType])); raise Exception.Create('please install the proper decompressor!'); end else begin {hPalette := GetCurrentObject(GetDC(Handle), OBJ_PAL); RetVal := ICDrawBegin(FCV.hic, ICDRAW_HDC, 0, Handle, GetDC(Handle), 0, 0, 200, 200, @FInInfo.bmiHeader, 0, 0, FInInfo.bmiHeader.biWidth, FInInfo.bmiHeader.biHeight, FCV.lDataRate, FCV.lDataRate / FCV.lKey); if RetVal == ICERR_UNSUPPORTED then begin mmReport.Lines.Add('ICERR_UNSUPPORTED'); MessageBox(Handle, 'ICERR_UNSUPPORTED', 'Error', MB_OK or MB_ICONERROR); // raise ??是抛出异常吧?? end; } FOutFormatSize := ICDecompressGetFormatSize(FCV.hic, @FInInfo.bmiHeader); FillChar(FOutInfo, SizeOf(FOutInfo), 0); ICDecompressGetFormat(FCV.hic, @FInInfo, @FOutInfo); mmReport.Lines.Add(Format('Out Format Height: %d', [FOutInfo.bmiHeader.biHeight])); FOutBufSize := FOutInfo.bmiHeader.biSizeImage; if Assigned(FOutBuf) then FreeMem(FOutBuf); GetMem(FOutBuf, FOutBufSize); FillChar(FOutBuf^, FOutBufSize, 0); mmReport.Lines.Add(Format('Out buffer size:%d', [FOutBufSize])); ICDecompressBegin(FCV.hic, @FInInfo, @FOutInfo); end; end;end;procedure TClientForm.ShowImage(Buf: PByte); //这句可能有错,试一下其它方法,如直接对Image1.Handle, Image1.Canvas.handle赋值之类. procedure SetImage(hBitmap: THandle); begin SendMessage(Image1.Picture.Bitmap.Handle, STM_SETIMAGE, IMAGE_BITMAP, Integer(hBitmap)); end;var pData: Pointer; pDC, MemDC: THandle; hBitmap: THandle;{ FileStream: TFileStream; FileHeader: TBitmapFileHeader; }begin {FileStream := TFileStream.Create('D:\Ok.bmp', fmCreate); FillChar(FileHeader, SizeOf(FileHeader), 0); with FileHeader, FileStream do try bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader); bfSize := bfOffBits + FOutBufSize; bfType := $4D42; WriteBuffer(FileHeader, SizeOf(FileHeader)); WriteBuffer(FOutInfo, SizeOf(FOutInfo)); WriteBuffer(Buf^, FOutBufSize); finally Free; end;} mmReport.Lines.Add(Format('K = %d', [PByte(Integer(Buf) + 150)^])); pDC := GetDC(Handle); pData := nil; hBitmap := CreateDIBSection(0, FOutInfo, DIB_RGB_COLORS, pData, 0, 0); if not Assigned(pData) and (hBitmap = 0) then begin mmReport.Lines.Add(Format('CreateDIBSection Error, ErrCode: %d', [GetLastError])); Abort; end; pData := Buf; SetImage(hBitmap); GdiFlush; MemDC := CreateCompatibleDC(pDC); SelectObject(MemDC, hBitmap); BitBlt(pDC, 0, 0, FOutInfo.bmiHeader.biWidth, FOutInfo.bmiHeader.biHeight, MemDC, 0, 0, SRCCOPY); DeleteDC(MemDC);// SetDIBitsToDevice(pDC, 0, 0, FOutInfo.bmiHeader.biWidth, FOutInfo.bmiHeader.biHeight,// 0, 0, 0, FOutInfo.bmiHeader.biHeight, Buf, FOutInfo, DIB_RGB_COLORS);end;procedure TClientForm.btnConnectClick(Sender: TObject);begin with ClientSocket1 do begin if Active then begin Close; Sleep(100); end; Address := edIPAddr.Text; Open; end;end; procedure TClientForm.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);begin mmReport.Lines.Add(Format('Socket出错了,代码:%d, 信息:%s', [ErrorCode, SysErrorMessage(ErrorCode)])); ErrorCode := 0;end;procedure TClientForm.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);var Len, RetVal: Integer; VideoData: TVideoDataInfo; ServerCtrl: TServerControlInfo;begin Len := Socket.ReceiveLength; if FRecvHeaderTimes <= 1 then //发了两次控制信息 begin FillChar(ServerCtrl, SizeOf(ServerCtrl), 0); if Len > SizeOf(ServerCtrl) then Len := SizeOf(ServerCtrl); Socket.ReceiveBuf(ServerCtrl, Len); ExecuteServerCommand(ServerCtrl); Inc(FRecvHeaderTimes); end else begin FillChar(VideoData, SizeOf(VideoData), 0); if Len > SizeOf(VideoData) then Len := SizeOf(VideoData); Socket.ReceiveBuf(VideoData, Len); if (VideoData.nUsedSize > 0) and (VideoData.nUsedSize < 8180) then begin mmReport.Lines.Add(Format('Get Compressed Data: %d', [VideoData.nUsedSize])); RetVal := ICDeCompress(FCV.hic, 0, @FInInfo.bmiHeader, @VideoData.Buf[0], @FOutInfo.bmiHeader, FOutBuf); if RetVal = ICERR_OK then begin //需不需要调用ShowImage?? //ShowImage(FOutBuf); SetDIBitsToDevice(GetDC(Handle), 0, 0, FOutInfo.bmiHeader.biWidth, FOutInfo.bmiHeader.biHeight, 0, 0, 0, FOutInfo.bmiHeader.biHeight, FOutBuf, FOutInfo, DIB_RGB_COLORS); end; end; end;end;procedure TClientForm.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);begin FRecvHeaderTimes := 0; mmReport.Lines.Add(Format('已经连接上:%s 主机', [Socket.RemoteAddress]))end;procedure TClientForm.ClientSocket1Connecting(Sender: TObject; Socket: TCustomWinSocket);begin mmReport.Lines.Add(Format('请等待, 正在连接:%s 主机...', [Socket.RemoteAddress]))end;procedure TClientForm.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);begin FRecvHeaderTimes := 0; mmReport.Lines.Add(Format('断开与%s 主机的连接', [Socket.RemoteAddress]))end;constructor TClientForm.Create(AOwner: TComponent);begin inherited Create(AOwner); FOutBuf := nil; FillChar(FCV, SizeOf(FCV), 0); FillChar(FInInfo, SizeOf(FInInfo), 0); FIllChar(FOutInfo, SizeOf(FOutInfo), 0); FOutBufSize := 0; FOutFormatSize := 0; ClientSocket1.Port := CONNECTPORT;end;destructor TClientForm.Destroy;begin if Assigned(FOutBuf) then FreeMem(FOutBuf); if FCV.hic <> 0 then //ICDrawEnd(m_CV.hic); ICClose(FCV.hic); inherited Destroy;end;end.//Client Main.dfmobject ClientForm: TClientForm Left = 87 Top = 79 Width = 440 Height = 414 Caption = 'ClientForm' Color = clBtnFace Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -12 Font.Name = 'Courier New' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 15 object Image1: TImage Left = 0 Top = 0 Width = 432 Height = 241 Align = alTop end object edIPAddr: TEdit Left = 16 Top = 256 Width = 209 Height = 23 TabOrder = 0 Text = '127.0.0.1' end object btnConnect: TButton Left = 232 Top = 254 Width = 97 Height = 25 Caption = '连接主机(&L)' TabOrder = 1 OnClick = btnConnectClick end object mmReport: TMemo Left = 0 Top = 288 Width = 432 Height = 99 Align = alBottom ScrollBars = ssVertical TabOrder = 2 end object ClientSocket1: TClientSocket Active = False ClientType = ctNonBlocking Port = 0 OnConnecting = ClientSocket1Connecting OnConnect = ClientSocket1Connect OnDisconnect = ClientSocket1Disconnect OnRead = ClientSocket1Read OnError = ClientSocket1Error Left = 344 Top = 256 endend http://tty.yyun.net/lovejingtao/htm/olddefault.htm http://tty-1.51.net/cjt/Mpeg1Decode.zip http://tty.yyun.net/lovejingtao/htm/olddefault.htm 不能访问? 在DELPHI的动态库中调用问题? 请问在存储过程中的事务如何写? 如何通过程序实现网卡的启用和禁止功能? 大家好,请问mscomm32.ocx为什么安装不上 评高工,大家有什么建议 终止线程的问题;不会也来看看了; 我的构件想扑捉vk_left等键,但不行,那为给看看 关于QuickReport的preview的一个问题 求助,打印问题!!! ZwQueryInformationThread 如何使用呢? 有哪些关于delphi开发多线程的书籍? DBGrid怎样使用文本文件作为数据源?
program Client;uses
Forms,
Main in 'Main.pas' {ClientForm},
VFW in '..\VFW.pas',
VideoConsts in '..\VideoConsts.pas';{$R *.res}begin
Application.Initialize;
Application.CreateForm(TClientForm, ClientForm);
Application.Run;
end.//Client main.pas
unit Main;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, VideoConsts, VFW, StdCtrls, ExtCtrls;type
TClientForm = class(TForm)
Image1: TImage;
ClientSocket1: TClientSocket;
edIPAddr: TEdit;
btnConnect: TButton;
mmReport: TMemo;
procedure btnConnectClick(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ 接收头信息, 一连接后,服务端发送头信息TServerControlInfo(two times),
之后是_VEDEO_DATA数据 }
FRecvHeaderTimes: Byte;
FCV: TCOMPVARS;
FOutBuf: PByte;
FOutBufSize: DWORD;
FInInfo: TBitmapInfo;
FOutInfo: TBitmapInfo;
FOutFormatSize: DWORD;
{$HINTS OFF}
procedure ShowImage(Buf: PByte);
{$HINTS ON}
procedure ExecuteServerCommand(msg: TServerControlInfo);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;var
ClientForm: TClientForm;implementation{$R *.dfm}
procedure TClientForm.ExecuteServerCommand(msg: TServerControlInfo);
var
Cmd: string;
{ RetVal: Integer;
hPalette: THandle;}
begin
Cmd := msg.strCommand;
if SameText(Cmd, 'Set Bitmap Info') then
begin
Move(msg.strContent, FInInfo, SizeOf(FInInfo));
mmReport.Lines.Add(Format('FInInfo.bmiHeader .biHeight:%d, .biBitCount:%d',
[FInInfo.bmiHeader.biHeight, FInInfo.bmiHeader.biBitCount]));
end else
if SameText(Cmd, 'Set COMPVARS') then
begin
Move(msg.strContent, FCV, SizeOf(FCV));
mmReport.Lines.Add(FOrmat('FCV.cbSize: %d', [FCV.cbSize]));
//FCV.hic := ICDrawOpen(FCV.fccType, FCV.fccHandler, @FInInfo.bmiHeader);
FCV.hic := ICOpen(FCV.fccType, FCV.fccHandler, ICMODE_DECOMPRESS);
if FCV.hic = 0 then
begin
mmReport.Lines.Add(Format('FCV.fccType: %d', [FCV.fccType]));
raise Exception.Create('please install the proper decompressor!');
end else
begin
{hPalette := GetCurrentObject(GetDC(Handle), OBJ_PAL);
RetVal := ICDrawBegin(FCV.hic, ICDRAW_HDC, 0, Handle,
GetDC(Handle), 0, 0, 200, 200, @FInInfo.bmiHeader,
0, 0, FInInfo.bmiHeader.biWidth, FInInfo.bmiHeader.biHeight,
FCV.lDataRate, FCV.lDataRate / FCV.lKey);
if RetVal == ICERR_UNSUPPORTED then
begin
mmReport.Lines.Add('ICERR_UNSUPPORTED');
MessageBox(Handle, 'ICERR_UNSUPPORTED', 'Error', MB_OK or MB_ICONERROR);
// raise ??是抛出异常吧??
end; }
FOutFormatSize := ICDecompressGetFormatSize(FCV.hic, @FInInfo.bmiHeader);
FillChar(FOutInfo, SizeOf(FOutInfo), 0);
ICDecompressGetFormat(FCV.hic, @FInInfo, @FOutInfo);
mmReport.Lines.Add(Format('Out Format Height: %d', [FOutInfo.bmiHeader.biHeight]));
FOutBufSize := FOutInfo.bmiHeader.biSizeImage;
if Assigned(FOutBuf) then FreeMem(FOutBuf);
GetMem(FOutBuf, FOutBufSize);
FillChar(FOutBuf^, FOutBufSize, 0);
mmReport.Lines.Add(Format('Out buffer size:%d', [FOutBufSize]));
ICDecompressBegin(FCV.hic, @FInInfo, @FOutInfo);
end;
end;
end;procedure TClientForm.ShowImage(Buf: PByte); //这句可能有错,试一下其它方法,如直接对Image1.Handle, Image1.Canvas.handle赋值之类.
procedure SetImage(hBitmap: THandle);
begin
SendMessage(Image1.Picture.Bitmap.Handle, STM_SETIMAGE, IMAGE_BITMAP, Integer(hBitmap));
end;var
pData: Pointer;
pDC, MemDC: THandle;
hBitmap: THandle;
{ FileStream: TFileStream;
FileHeader: TBitmapFileHeader; }
begin
{FileStream := TFileStream.Create('D:\Ok.bmp', fmCreate);
FillChar(FileHeader, SizeOf(FileHeader), 0);
with FileHeader, FileStream do
try
bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader);
bfSize := bfOffBits + FOutBufSize;
bfType := $4D42;
WriteBuffer(FileHeader, SizeOf(FileHeader));
WriteBuffer(FOutInfo, SizeOf(FOutInfo));
WriteBuffer(Buf^, FOutBufSize);
finally
Free;
end;}
mmReport.Lines.Add(Format('K = %d', [PByte(Integer(Buf) + 150)^]));
pDC := GetDC(Handle);
pData := nil;
hBitmap := CreateDIBSection(0, FOutInfo, DIB_RGB_COLORS, pData, 0, 0);
if not Assigned(pData) and (hBitmap = 0) then
begin
mmReport.Lines.Add(Format('CreateDIBSection Error, ErrCode: %d', [GetLastError]));
Abort;
end;
pData := Buf;
SetImage(hBitmap);
GdiFlush;
MemDC := CreateCompatibleDC(pDC);
SelectObject(MemDC, hBitmap);
BitBlt(pDC, 0, 0, FOutInfo.bmiHeader.biWidth, FOutInfo.bmiHeader.biHeight,
MemDC, 0, 0, SRCCOPY);
DeleteDC(MemDC);
// SetDIBitsToDevice(pDC, 0, 0, FOutInfo.bmiHeader.biWidth, FOutInfo.bmiHeader.biHeight,
// 0, 0, 0, FOutInfo.bmiHeader.biHeight, Buf, FOutInfo, DIB_RGB_COLORS);
end;procedure TClientForm.btnConnectClick(Sender: TObject);
begin
with ClientSocket1 do
begin
if Active then
begin
Close;
Sleep(100);
end;
Address := edIPAddr.Text;
Open;
end;
end;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
mmReport.Lines.Add(Format('Socket出错了,代码:%d, 信息:%s',
[ErrorCode, SysErrorMessage(ErrorCode)]));
ErrorCode := 0;
end;procedure TClientForm.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
Len, RetVal: Integer;
VideoData: TVideoDataInfo;
ServerCtrl: TServerControlInfo;
begin
Len := Socket.ReceiveLength;
if FRecvHeaderTimes <= 1 then //发了两次控制信息
begin
FillChar(ServerCtrl, SizeOf(ServerCtrl), 0);
if Len > SizeOf(ServerCtrl) then
Len := SizeOf(ServerCtrl);
Socket.ReceiveBuf(ServerCtrl, Len);
ExecuteServerCommand(ServerCtrl);
Inc(FRecvHeaderTimes);
end else
begin
FillChar(VideoData, SizeOf(VideoData), 0);
if Len > SizeOf(VideoData) then
Len := SizeOf(VideoData);
Socket.ReceiveBuf(VideoData, Len);
if (VideoData.nUsedSize > 0) and (VideoData.nUsedSize < 8180) then
begin
mmReport.Lines.Add(Format('Get Compressed Data: %d', [VideoData.nUsedSize]));
RetVal := ICDeCompress(FCV.hic, 0, @FInInfo.bmiHeader, @VideoData.Buf[0],
@FOutInfo.bmiHeader, FOutBuf);
if RetVal = ICERR_OK then
begin
//需不需要调用ShowImage??
//ShowImage(FOutBuf);
SetDIBitsToDevice(GetDC(Handle), 0, 0, FOutInfo.bmiHeader.biWidth,
FOutInfo.bmiHeader.biHeight, 0, 0, 0, FOutInfo.bmiHeader.biHeight,
FOutBuf, FOutInfo, DIB_RGB_COLORS);
end;
end;
end;
end;procedure TClientForm.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
FRecvHeaderTimes := 0;
mmReport.Lines.Add(Format('已经连接上:%s 主机', [Socket.RemoteAddress]))
end;procedure TClientForm.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
mmReport.Lines.Add(Format('请等待, 正在连接:%s 主机...', [Socket.RemoteAddress]))
end;procedure TClientForm.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
FRecvHeaderTimes := 0;
mmReport.Lines.Add(Format('断开与%s 主机的连接', [Socket.RemoteAddress]))
end;constructor TClientForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOutBuf := nil;
FillChar(FCV, SizeOf(FCV), 0);
FillChar(FInInfo, SizeOf(FInInfo), 0);
FIllChar(FOutInfo, SizeOf(FOutInfo), 0);
FOutBufSize := 0;
FOutFormatSize := 0;
ClientSocket1.Port := CONNECTPORT;
end;destructor TClientForm.Destroy;
begin
if Assigned(FOutBuf) then
FreeMem(FOutBuf);
if FCV.hic <> 0 then
//ICDrawEnd(m_CV.hic);
ICClose(FCV.hic);
inherited Destroy;
end;end.//Client Main.dfm
object ClientForm: TClientForm
Left = 87
Top = 79
Width = 440
Height = 414
Caption = 'ClientForm'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Courier New'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 15
object Image1: TImage
Left = 0
Top = 0
Width = 432
Height = 241
Align = alTop
end
object edIPAddr: TEdit
Left = 16
Top = 256
Width = 209
Height = 23
TabOrder = 0
Text = '127.0.0.1'
end
object btnConnect: TButton
Left = 232
Top = 254
Width = 97
Height = 25
Caption = '连接主机(&L)'
TabOrder = 1
OnClick = btnConnectClick
end
object mmReport: TMemo
Left = 0
Top = 288
Width = 432
Height = 99
Align = alBottom
ScrollBars = ssVertical
TabOrder = 2
end
object ClientSocket1: TClientSocket
Active = False
ClientType = ctNonBlocking
Port = 0
OnConnecting = ClientSocket1Connecting
OnConnect = ClientSocket1Connect
OnDisconnect = ClientSocket1Disconnect
OnRead = ClientSocket1Read
OnError = ClientSocket1Error
Left = 344
Top = 256
end
end