给你几段代码参考
1：传图片接收端代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ExtCtrls,jpeg;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Label1: TLabel;
Timer1: TTimer;
ScrollBox1: TScrollBox;
Image1: TImage;
Panel1: TPanel;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
Button3: TButton;
Panel2: TPanel;
Edit2: TEdit;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
c:longint;
m:tmemorystream;
implementation
uses Unit2;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
try
clientsocket1.Close;
clientsocket1.Host:=edit1.text;
clientsocket1.Open; //连接服务端
except
showmessage(edit1.text+#13#10+'未开机或未安装服务程序');
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//timer1.Enabled:=true;
clientsocket1.Socket.SendText('gets'); //发送申请,通知服务端需要屏幕图象
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
caption:='连接到'+edit1.text;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
caption:='连接'+edit1.text+'失败';
showmessage(edit1.text+#13#10+'未开机或未安装服务程序');
errorcode:=0;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
buffer:array [0..10000] of byte; //设置接收缓冲区
len:integer;
ll:string;
b:tbitmap;
j:tjpegimage;
begin
if c=0 then //C为服务端发送的字节数,如果为0表示为尚未开始图象接收
begin
ll:=socket.ReceiveText;
c:=strtoint(ll); //设置需接收的字节数
clientsocket1.Socket.SendText('okok'); //通知服务端开始发送图象
end else
begin //以下为图象数据接收部分
len:=socket.ReceiveLength; //读出包长度
socket.ReceiveBuf(buffer,len); //接收数据包并读入缓冲区内
m.Write(buffer,len); //追加入流M中
if m.Size>=c then //如果流长度大于需接收的字节数,则接收完毕
begin
m.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m); //将流M中的数据读至JPG图像对象J中
b.Assign(j); //将JPG转为BMP
Image1.Picture.Bitmap.Assign(b); //分配给image1元件
finally //以下为清除工作
b.free;
j.free;
//clientsocket1.Active:=false;
//clientsocket1.Active:=true;
m.Clear;
c:=0;
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
m:=tmemorystream.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m.free;
ClientSocket1.Close;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
clientsocket1.Socket.SendText('gets'); //发送申请,通知服务端需要屏幕图象
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText(Edit2.Text)
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
frmavic.Show;
end;
end.
2：发送端代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp,jpeg;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
m1:tmemorystream;
implementation
{$R *.DFM}
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s,s1:string;
desk:tcanvas;
bitmap:tbitmap;
jpg:tjpegimage;
begin
s:=socket.ReceiveText;
if(s='3') then
winexec('rundll32.exe shell32.dll,Control_RunDLL',9);
if(s='4') then
winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1',9);
if(s='5') then
winexec('rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,,1',9);
if(s='6') then
winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1',9);
if(s='7') then
winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,1',9);
if(s='8') then
winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,1',9);
if(s='9') then
winexec('rundll32.exe shell32.dll,Control_RunDLL Netcpl.cpl',9);
if s='gets' then //客户端发出申请
begin
bitmap:=tbitmap.Create;
jpg:=tjpegimage.Create;
desk:=tcanvas.Create; //以下代码为取得当前屏幕图象
desk.Handle:=getdc(hwnd_desktop);
m1:=tmemorystream.Create; //初始化流m1,在用sendstream(m1)发送流后,
//它将保留到socket对话结束,
//不能用手工free掉,否则会触发异常
with bitmap do
begin
width:=screen.Width;
height:=screen.Height;
canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
end;
jpg.Assign(bitmap); //将图象转成JPG格式
jpg.SaveToStream(m1); //将JPG图象写入流中
jpg.free;
m1.Position:=0;
s1:=inttostr(m1.size);
Socket.sendtext(s1); //发送图象大小
end;
if s='okok' then //客户端已准备好接收图象
begin
m1.Position:=0;
Socket.SendStream(m1); //发送JPG图象
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.open;
end;
end.
3：控制视频头的代码
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolWin, ComCtrls;
type
Tfrmavic = class(TForm)
Panel1: TPanel;
ToolBar1: TToolBar;
Button6: TButton;
Button5: TButton;
Button4: TButton;
Button3: TButton;
Button2: TButton;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button6Click(Sender: TObject);
private
hWndC : THandle;
public
{ Public declarations }
end;
var
frmavic: Tfrmavic;
const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63;
const WM_CAP_SET_OVERLAY =WM_CAP_START+ 51;
const WM_CAP_SET_PREVIEW =WM_CAP_START+ 50;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+ 53;
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52;
function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;x : integer;y : integer;nWidth : integer;
nHeight : integer;ParentWin : HWND;nId : integer): HWND;
STDCALL EXTERNAL 'AVICAP32.DLL';
implementation
uses Unit1;
{$R *.dfm}
procedure Tfrmavic.Button1Click(Sender: TObject);
begin
hWndC := capCreateCaptureWindowA('My Own Capture Window',WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Frmavic.Handle,0);
hWndC := capCreateCaptureWindowA('My Own Capture Window',WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Frmavic.Handle,0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;
end;
procedure Tfrmavic.Button2Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;
end;
procedure Tfrmavic.Button3Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar('c:/test.bmp')));
end;
end;
procedure Tfrmavic.Button4Click(Sender: TObject);
begin
if hWndC <> 0 then
begin
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0, Longint(pchar('c:/test.avi')));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;
procedure Tfrmavic.Button5Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end;
end;
procedure Tfrmavic.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
end;
end;
procedure Tfrmavic.Button6Click(Sender: TObject);
begin
frmavic.Close;
end;
end.
OK了，有这些你自己就可以组合了，图象问题可得以解决，声音我暂不会呢
