大家一起来,就快完工了.视频网络传送(vc++------>>delphi)1000分. (300分)

  • 主题发起人 主题发起人 BlackDragon
  • 开始时间 开始时间
chenlili:
你可是高手,这里面还有很多问题,你再改改吧.[:)]
 
还有哪些,没完成的?我来试试,不过不知有没时间,:)
完成的哪些,不些就上面那些吧?
 
还有个vfw.pas在社区,你下来,上面的只是把函数翻译了一下,还没整理,肯定有一些
错误。你看看吧。
 
vfw.pas是你翻译的?我记得很多控件包都有,我回去对照一下我的。
那个工控界面所有的程序都下了我,我是问你哪些完成了,我也就懒的再去写了。
 
自己顶一下。[:D]
 
//Server.dpr
program Server;
uses
Forms,
Main in 'Main.pas' {ServerForm},
VFW in '../VFW.pas',
VideoConsts in '../VideoConsts.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TServerForm, ServerForm);
Application.Run;
end.

//VideoConsts.pas
unit VideoConsts;
interface
uses Windows;
const
BASEPORT = 5555;
LISTENPORT = BASEPORT;
CONNECTPORT = BASEPORT;

type
_SERVER_CTRL_MSG = record
strCommand: array [0..99] of Char;
nContentUsesByte: DWORD;
strContent: array [0..999] of Char;
end;
PServerControlInfo = ^TServerControlInfo;
TServerControlInfo = _SERVER_CTRL_MSG;
PClientControlInfo = ^TClientControlInfo;
TClientControlInfo = _SERVER_CTRL_MSG;
_VIDEO_DATA = record
bKeyFrame: Boolean;
nSampleNum: DWORD;
nUsedSize: DWORD;
Buf: array [0..8179] of Byte;
end;
PVideoDataInfo = ^TVideoDataInfo;
TVideoDataInfo = _VIDEO_DATA;
implementation
end.

//main.dfm
object ServerForm: TServerForm
Left = 243
Top = 189
BorderStyle = bsDialog
Caption = 'ServerForm'
ClientHeight = 73
ClientWidth = 338
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 16
object Label1: TLabel
Left = 8
Top = 8
Width = 41
Height = 16
Caption = 'Label1'
end
object ServerSocket1: TServerSocket
Active = False
Port = 0
ServerType = stNonBlocking
OnClientConnect = ServerSocket1ClientConnect
Left = 8
Top = 32
end
end
//main.pas
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, VideoConsts, VFW, StdCtrls;
type
TServerForm = class(TForm)
ServerSocket1: TServerSocket;
Label1: TLabel;
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
private
FCV: TCOMPVARS;
FInInfo: TBitmapInfo;
FOutInfo: TBitmapInfo;
FCaptureHandle: THandle;
FSampleNum: DWORD;
FOutActSize: DWORD;
FOutFormatSize: DWORD;
FOutBufferSize: DWORD;

procedure FillBitmapStruc;
procedure InitVideoCard;
procedure CompareFrame(lpVHdr: PVIDEOHDR);
procedure InitCompressor;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
{ Public declarations }
end;

var
ServerForm: TServerForm;
implementation
{$R *.dfm}
function FrameCallBack(hWnd: HWND;
lpVHdr: PVIDEOHDR): DWORD;
stdcall;
begin
if ServerForm.ServerSocket1.Active then
ServerForm.CompareFrame(lpVHdr);
Result := DWORD(True);
end;

constructor TServerForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSampleNum := 0;
FillBitmapStruc;
InitVideoCard;
InitCompressor;
ServerSocket1.Port := LISTENPORT;
ServerSocket1.Active := True;
end;

destructor TServerForm.Destroy;
begin
if FCV.hic <> 0 then
begin
ICSeqCompressFrameEnd(@FCV);
ICCompressorFree(@FCV);
ICClose(FCV.hic);
end;
capSetCallbackOnFrame(FCaptureHandle, FrameCallBack);
capDriverDisconnect(FCaptureHandle);
inherited Destroy;
end;

procedure TServerForm.FillBitmapStruc;
begin
FillChar(FInInfo.bmiHeader, SizeOf(TBitmapInfoHeader), 0);
with FInInfo.bmiHeaderdo
begin
biBitCount := 24;
biCompression := BI_RGB;
biHeight := 240;
biPlanes := 1;
biSize := SizeOf(TBitmapInfoHeader);
biWidth := 320;
end;
end;

procedure TServerForm.CompareFrame(lpVHdr: PVIDEOHDR);
var
Buffer: PByte;
KeyFrame: Boolean;
VideoData: TVideoDataInfo;
begin
FOutActSize := FInInfo.bmiHeader.biSizeImage;
Buffer := ICSeqCompressFrame(@FCV, 0, lpVHdr^.lpData, @KeyFrame, @FOutActSize);
if ServerSocket1.Active and (FOutActSize < 8180) then
begin
FillChar(VideoData, SizeOf(TVideoDataInfo), 0);
VideoData.bKeyFrame := KeyFrame;
Move(Buffer^, VideoData.Buf, FOutActSize);
VideoData.nSampleNum := FSampleNum;
VideoData.nUsedSize := FOutActSize;
// for I := 0 to ServerSocket1.Socket.ActiveConnections - 1do
// ServerSocket1.Socket.Connections.SendBuf(VideoData, SizeOf(VideoData));
if ServerSocket1.Socket.ActiveConnections > 0 then
ServerSocket1.Socket.Connections[0].SendBuf(VideoData, SizeOf(VideoData));
Inc(FSampleNum);
end;
end;

procedure TServerForm.InitVideoCard;
begin
FCaptureHandle := capCreateCaptureWindow('Capture Window',
WS_VISIBLE or WS_CHILD, 0, 0, 320, 240, Handle, 1);
capDriverConnect(FCaptureHandle, 0);
//set the video format
capSetVideoFormat(FCaptureHandle, @FInInfo, SizeOf(FInInfo));
capPreviewRate(FCaptureHandle, 40);
//capDlgVideoFormat(FCaptureHandle);
capPreview(FCaptureHandle, True);
capSetCallbackOnFrame(FCaptureHandle, FrameCallBack);
end;

procedure TServerForm.InitCompressor;
begin
FillChar(FCV, SizeOf(FCV), 0);
with FCVdo
begin
dwFlags := ICMF_COMPVARS_VALID;
cbSize := SizeOf(FCV);
fccHandler := mmioFOURCC('d','i','v','x');
fccType := ICTYPE_VIDEO;
hic := ICOpen(ICTYPE_VIDEO, mmioFOURCC('d','i','v','x'), ICMODE_COMPRESS);
lDataRate := 780;
lKey := 15;
lQ := ICQUALITY_DEFAULT;
if hic <> 0 then
begin
//调试一下,是FInInfo.bmiHeader还是FInInfo;
//FOutFormatSize := ICCompressGetFormatSize(hic, @FInInfo.bmiHeader);
FOutFormatSize := ICCompressGetFormatSize(hic, @FInInfo);
FillChar(FOutInfo, SizeOf(FOutInfo), 0);
//调试一下,是FOutInfo.bmiHeader还是FOutInfo;
//ICCompressGetFormat(hic, @FInInfo.bmiHeader, @FOutInfo.bmiHeader);
ICCompressGetFormat(hic, @FInInfo, @FOutInfo);
//调试一下,是它们的bmiHeader还是自已;
//FOutBufferSize := ICCompressGetSize(hic, @FInInfo.bmiHeader, @FOutInfo.bmiHeader);
FOutBufferSize := ICCompressGetSize(hic, @FInInfo, @FOutInfo);
ICSeqCompressFrameStart(@FCV, @FInInfo);
end;
end;
end;

procedure TServerForm.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
msg: TServerControlInfo;
begin
Label1.Caption := 'User Connected,begin
transporting video image!';
FillChar(msg, SizeOf(msg), 0);
msg.strCommand := 'Set Bitmap Info';
Move(FOutInfo, msg.strContent, SizeOf(msg.strContent));
msg.nContentUsesByte := SizeOf(msg.strContent);
Socket.SendBuf(msg, SizeOf(msg));
FillChar(msg, SizeOf(msg), 0);
msg.strCommand := 'Set COMPVARS';
msg.nContentUsesByte := SizeOf(FCV);
Move(FCV, msg.strContent, SizeOf(FCV));
Socket.SendBuf(msg, SizeOf(msg));
end;

end.

 
一个老兄翻译的:
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, VideoConsts, VFW, StdCtrls;
type
TServerForm = class(TForm)
ServerSocket1: TServerSocket;
Label1: TLabel;
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
private
FCV: TCOMPVARS;
FInInfo: TBitmapInfo;
FOutInfo: TBitmapInfo;
FCaptureHandle: THandle;
FSampleNum: DWORD;
FOutActSize: DWORD;
FOutFormatSize: DWORD;
FOutBufferSize: DWORD;

procedure FillBitmapStruc;
procedure InitVideoCard;
procedure CompareFrame(lpVHdr: PVIDEOHDR);
procedure InitCompressor;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
{ Public declarations }
end;

var
ServerForm: TServerForm;
implementation
{$R *.dfm}
function FrameCallBack(hWnd: HWND;
lpVHdr: PVIDEOHDR): DWORD;
stdcall;
begin
if ServerForm.ServerSocket1.Active then
ServerForm.CompareFrame(lpVHdr);
Result := DWORD(True);
end;

constructor TServerForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSampleNum := 0;
FillBitmapStruc;
InitVideoCard;
InitCompressor;
ServerSocket1.Port := LISTENPORT;
ServerSocket1.Active := True;
end;

destructor TServerForm.Destroy;
begin
if FCV.hic <> 0 then
begin
ICSeqCompressFrameEnd(@FCV);
ICCompressorFree(@FCV);
ICClose(FCV.hic);
end;
capSetCallbackOnFrame(FCaptureHandle, FrameCallBack);
capDriverDisconnect(FCaptureHandle);
inherited Destroy;
end;

procedure TServerForm.FillBitmapStruc;
begin
FillChar(FInInfo.bmiHeader, SizeOf(TBitmapInfoHeader), 0);
with FInInfo.bmiHeaderdo
begin
biBitCount := 24;
biCompression := BI_RGB;
biHeight := 240;
biPlanes := 1;
biSize := SizeOf(TBitmapInfoHeader);
biWidth := 320;
end;
end;

procedure TServerForm.CompareFrame(lpVHdr: PVIDEOHDR);
var
Buffer: PByte;
KeyFrame: Boolean;
VideoData: TVideoDataInfo;
begin
FOutActSize := FInInfo.bmiHeader.biSizeImage;
Buffer := ICSeqCompressFrame(@FCV, 0, lpVHdr^.lpData, @KeyFrame, @FOutActSize);
if ServerSocket1.Active and (FOutActSize < 8180) then
begin
FillChar(VideoData, SizeOf(TVideoDataInfo), 0);
VideoData.bKeyFrame := KeyFrame;
Move(Buffer^, VideoData.Buf, FOutActSize);
VideoData.nSampleNum := FSampleNum;
VideoData.nUsedSize := FOutActSize;
// for I := 0 to ServerSocket1.Socket.ActiveConnections - 1do
// ServerSocket1.Socket.Connections.SendBuf(VideoData, SizeOf(VideoData));
if ServerSocket1.Socket.ActiveConnections > 0 then
ServerSocket1.Socket.Connections[0].SendBuf(VideoData, SizeOf(VideoData));
Inc(FSampleNum);
end;
end;

procedure TServerForm.InitVideoCard;
begin
FCaptureHandle := capCreateCaptureWindow('Capture Window',
WS_VISIBLE or WS_CHILD, 0, 0, 320, 240, Handle, 1);
capDriverConnect(FCaptureHandle, 0);
//set the video format
capSetVideoFormat(FCaptureHandle, @FInInfo, SizeOf(FInInfo));
capPreviewRate(FCaptureHandle, 40);
//capDlgVideoFormat(FCaptureHandle);
capPreview(FCaptureHandle, True);
capSetCallbackOnFrame(FCaptureHandle, FrameCallBack);
end;

procedure TServerForm.InitCompressor;
begin
FillChar(FCV, SizeOf(FCV), 0);
with FCVdo
begin
dwFlags := ICMF_COMPVARS_VALID;
cbSize := SizeOf(FCV);
fccHandler := mmioFOURCC('d','i','v','x');
fccType := ICTYPE_VIDEO;
hic := ICOpen(ICTYPE_VIDEO, mmioFOURCC('d','i','v','x'), ICMODE_COMPRESS);
lDataRate := 780;
lKey := 15;
lQ := ICQUALITY_DEFAULT;
if hic <> 0 then
begin
//调试一下,是FInInfo.bmiHeader还是FInInfo;
//FOutFormatSize := ICCompressGetFormatSize(hic, @FInInfo.bmiHeader);
FOutFormatSize := ICCompressGetFormatSize(hic, @FInInfo);
FillChar(FOutInfo, SizeOf(FOutInfo), 0);
//调试一下,是FOutInfo.bmiHeader还是FOutInfo;
//ICCompressGetFormat(hic, @FInInfo.bmiHeader, @FOutInfo.bmiHeader);
ICCompressGetFormat(hic, @FInInfo, @FOutInfo);
//调试一下,是它们的bmiHeader还是自已;
//FOutBufferSize := ICCompressGetSize(hic, @FInInfo.bmiHeader, @FOutInfo.bmiHeader);
FOutBufferSize := ICCompressGetSize(hic, @FInInfo, @FOutInfo);
ICSeqCompressFrameStart(@FCV, @FInInfo);
end;
end;
end;

procedure TServerForm.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
msg: TServerControlInfo;
begin
Label1.Caption := 'User Connected,begin
transporting video image!';
FillChar(msg, SizeOf(msg), 0);
msg.strCommand := 'Set Bitmap Info';
Move(FOutInfo, msg.strContent, SizeOf(msg.strContent));
msg.nContentUsesByte := SizeOf(msg.strContent);
Socket.SendBuf(msg, SizeOf(msg));
FillChar(msg, SizeOf(msg), 0);
msg.strCommand := 'Set COMPVARS';
msg.nContentUsesByte := SizeOf(FCV);
Move(FCV, msg.strContent, SizeOf(FCV));
Socket.SendBuf(msg, SizeOf(msg));
end;

procedure TServerForm.FormCreate(Sender: TObject);
begin

end;

end.
 
Client没时间,next time
 
客户端程序
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;
interface
uses
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, FileStreamdo
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 ClientSocket1do
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.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 = '连接主机(&amp;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
 
MFC对其类的封装的很简单,以上的基本是宏来的,
我是对照着C的原程序翻译的,也不太清楚哪里会出错,
还有我下载的那些程序很多部分是注释掉了,所以我写的时候也是把对应的注释掉了,
你自己修改了
老兄,你的Mail我又不知哪去了(不小心又删了),[:D],所以在这里发了,
如果有什么问题,发信给我
 
老哥,再努力改成文件流视频广播的,我再加1000分,这个分就先给你了,我现在调试不了.
没视频采集卡.
 
41分钟,今天的手表是不是有问题了,怎么走这么慢.
  42分钟,我快要坐不住了,真想站一会儿.
  43分钟,下了课赶紧干事情..
  44分钟,现在的心情真好呀. 45分钟,唉,这节课又浪费了,下节课努力呀.
  叮..........
  不要问14-40分钟的时候到哪儿去了,我也不知道,因为周公找我下棋啦
 
这个client我总觉得翻译的不好,我再看看.
 
象黑龙学习了,
现在黑友的技术水平真是直线上升
 
程云怎么又糗我
 
我没有VFW.pas,哪位可以费劲给一个
tsedlinux@sina.com
我用的是D6
 
我来调试,各位最好是把此贴传下去,主要是用来反映调试中出现的问题,即时修改,
以便把该程序改得更好,做得更完善!
大家觉得如何?
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部