客户端程序
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 = '连接主机(&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