两台电脑之间通过internet传输图片问题(100分)

两台电脑之间通过internet进行点对点传输图片,我不知道该如何下手,那位朋友作过这样的
程序请给我一些帮助,谢谢了.

当普通文件传就可以了

QQ

谈Delphi编程中“流”的利用(五)
Boymaster


摘　要：谈Delphi编程中“流”的利用
关键字：流
类　别：文件操作


五、实际应用之四：利用流实现网络传输屏幕图像

　　大家应该见过很多网管程序，这类程序其中有一个功能就是监控远程电脑的屏幕。实际上，这也是利用流操作来实现的。下面我们给出一个例子，这个例子分两个程序，一个服务端，一个是客户端。程序编译后可以直接在单机、局部网或者互联网上使用。程序中已经给出相应注释。后面我们再来作具体分析。

　　新建一个工程，在Internet面版上拖一个ServerSocket控件到窗口，该控件主要用于监听客户端，用来与客户端建立连接和通讯。设置好监听端口后调用方法Open或者Active:=True即开始工作。注意：跟前面的NMUDP不同，当Socket开始监听后就不能再改变它的端口，要改变的话必须先调用Close或设置Active为False，否则将会产生异常。另外，如果该端口已经打开的话，就不能再用这个端口了。所以程序运行尚未退出就不能再运行这个程序，否则也会产生异常，即弹出出错窗口。实际应用中可以通过判断程序是否已经运行，如果已经运行就退出的方法来避免出错。

　　当客户端有数据传入，将触发ServerSocket1ClientRead事件，我们可以在这里对接收的数据进行处理。在本程序中，主要是接收客户端发送过来的字符信息并根据事先的约定来进行相应操作。

程序全部代码如下：

unit Unit1; {服务端程序}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, JPEG, ExtCtrls, ScktComp;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
{自定义抓屏函数,DrawCur表示抓鼠标图像与否}
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyStream: TMemorystream; {内存流对象}
implementation
{$R *.DFM}

procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var
Cursorx, Cursory: integer;
dc: hdc;
Mycan: Tcanvas;
R: TRect;
DrawPos: TPoint;
MyCursor: TIcon;
hld: hwnd;
Threadld: dword;
mp: tpoint;
pIconInfo: TIconInfo;
begin
Mybmp := Tbitmap.Create; {建立BMPMAP }
Mycan := TCanvas.Create; {屏幕截取}
dc := GetWindowDC(0);
try
Mycan.Handle := dc;
R := Rect(0, 0, screen.Width, screen.Height);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;
if DrawCur then {画上鼠标图象}
begin
GetCursorPos(DrawPos);
MyCursor := TIcon.Create;
getcursorpos(mp);
hld := WindowFromPoint(mp);
Threadld := GetWindowThreadProcessId(hld, nil);
AttachThreadInput(GetCurrentThreadId, Threadld, True);
MyCursor.Handle := Getcursor();
AttachThreadInput(GetCurrentThreadId, threadld, False);
GetIconInfo(Mycursor.Handle, pIconInfo);
cursorx := DrawPos.x - round(pIconInfo.xHotspot);
cursory := DrawPos.y - round(pIconInfo.yHotspot);
Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {画上鼠标}
Mycursor.ReleaseHandle; {释放数组内存}
MyCursor.Free; {释放鼠标指针}
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Port := 3000; {端口}
ServerSocket1.Open; {Socket开始侦听}
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ServerSocket1.Active then ServerSocket1.Close; {关闭Socket}
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
S, S1: string;
MyBmp: TBitmap;
Myjpg: TJpegimage;
begin
S := Socket.ReceiveText;
if S = 'cap' then {客户端发出抓屏幕指令}
begin
try
MyStream := TMemorystream.Create; {建立内存流}
MyBmp := TBitmap.Create;
Myjpg := TJpegimage.Create;
Cjt_GetScreen(MyBmp, True); {True表示抓鼠标图像}
Myjpg.Assign(MyBmp); {将BMP图象转成JPG格式,便于在互联网上传输}
Myjpg.CompressionQuality := 10; {JPG文件压缩百分比设置,数字越大图像月清晰,但数据也越大}
Myjpg.SaveToStream(MyStream); {将JPG图象写入流中}
Myjpg.free;
MyStream.Position := 0; {注意:必须添加此句}
s1 := inttostr(MyStream.size); {流的大小}
Socket.sendtext(s1); {发送流大小}
finally
MyBmp.free;
end;
end;
if s = 'ready' then {客户端已准备好接收图象}
begin
MyStream.Position := 0;
Socket.SendStream(MyStream); {将流发送出去}
end;
end;
end.

　　上面是服务端，下面我们来写客户端程序。新建一个工程，添加Socket控件ClientSocket、图像显示控件Image、一个 Panel 、一个Edit、两个 Button和一个状态栏控件StatusBar1。注意：把Edit1和两个 Button放在Panel1上面。ClientSocket的属性跟ServerSocket差不多，不过多了一个Address属性，表示要连接的服务端IP地址。填上IP地址后点“连接”将与服务端程序建立连接，如果成功就可以进行通讯了。点击“抓屏”将发送字符给服务端。因为程序用到了JPEG图像单元，所以要在Uses中添加Jpeg.


全部代码如下：
unit Unit2 {客户端};
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ScktComp, ExtCtrls, Jpeg, ComCtrls;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Image1: TImage;
StatusBar1: TStatusBar;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
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 ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MySize: Longint;
MyStream: TMemorystream; {内存流对象}
implementation
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
{-------- 下面为设置窗口控件的外观属性 ------------- }
{注意:把Button1、Button2和Edit1放在Panel1上面}
Edit1.Text := '127.0.0.1';
Button1.Caption := '连接主机';
Button2.Caption := '抓屏幕';
Button2.Enabled := false;
Panel1.Align := alTop;
Image1.Align := alClient;
Image1.Stretch := True;
StatusBar1.Align := alBottom;
StatusBar1.SimplePanel := True;
{----------------------------------------------- }
MyStream := TMemorystream.Create; {建立内存流对象}
MySize := 0; {初始化}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if not ClientSocket1.Active then
begin
ClientSocket1.Address := Edit1.Text; {远程IP地址}
ClientSocket1.Port := 3000; {Socket端口}
ClientSocket1.Open; {建立连接}
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Clientsocket1.Socket.SendText('cap'); {发送指令通知服务端抓取屏幕图象}
Button2.Enabled := False;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '成功建立连接!';
Button2.Enabled := True;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Errorcode := 0; {不弹出出错窗口}
StatusBar1.SimpleText := '无法与主机' + ClientSocket1.Address + '建立连接!';
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '断开连接!';
Button2.Enabled := False;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
MyBuffer: array[0..10000] of byte; {设置接收缓冲区}
MyReceviceLength: integer;
S: string;
MyBmp: TBitmap;
MyJpg: TJpegimage;
begin
StatusBar1.SimpleText := '正在接收数据......';
if MySize = 0 then {MySize为服务端发送的字节数，如果为0表示为尚未开始图象接收}
begin
S := Socket.ReceiveText;
MySize := Strtoint(S); {设置需接收的字节数}
Clientsocket1.Socket.SendText('ready'); {发指令通知服务端开始发送图象}
end
else
begin {以下为图象数据接收部分}
MyReceviceLength := socket.ReceiveLength; {读出包长度}
StatusBar1.SimpleText := '正在接收数据,数据大小为:' + inttostr(MySize);
Socket.ReceiveBuf(MyBuffer, MyReceviceLength); {接收数据包并读入缓冲区内}
MyStream.Write(MyBuffer, MyReceviceLength); {将数据写入流中}
if MyStream.Size > = MySize then {如果流长度大于需接收的字节数，则接收完毕}
begin
MyStream.Position := 0;
MyBmp := tbitmap.Create;
MyJpg := tjpegimage.Create;
try
MyJpg.LoadFromStream(MyStream); {将流中的数据读至JPG图像对象中}
MyBmp.Assign(MyJpg); {将JPG转为BMP}
StatusBar1.SimpleText := '正在显示图像';
Image1.Picture.Bitmap.Assign(MyBmp); {分配给image1元件 }
finally {以下为清除工作 }
MyBmp.free;
MyJpg.free;
Button2.Enabled := true;
{ Socket.SendText('cap');添加此句即可连续抓屏 }
MyStream.Clear;
MySize := 0;
end;
end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyStream.Free; {释放内存流对象}
if ClientSocket1.Active then ClientSocket1.Close; {关闭Socket连接}
end;
end.

　　程序原理：运行服务端开始侦听，再运行客户端，输入服务端IP地址建立连接，然后发一个字符通知服务端抓屏幕。服务端调用自定义函数Cjt_GetScreen抓取屏幕存为BMP，把BMP转换成JPG，把JPG写入内存流中，然后把流发送给客户端。客户端接收到流后做相反操作，将流转换为JPG再转换为BMP然后显示出来。

　　注意：因为Socket的限制，不能一次发送过大的数据，只能分几次发。所以程序中服务端抓屏转换为流后先发送流的大小，通知客户端这个流共有多大，客户端根据这个数字大小来判断是否已经接收完流，如果接收完才转换并显示。

　　这个程序跟前面的自制OICQ都是利用了内存流对象TMemoryStream。其实，这个流对象是程序设计中用得最普遍的，它可以提高I/O的读写能力，而且如果你要同时操作几个不同类型的流，互相交换数据的话，用它作“中间人”是最好不过的了。比如说你把一个流压缩或者解压缩，就先建立一个TMemoryStream对象，然后把别的数据拷贝进去，再执行相应操作就可以了。因为它是直接在内存中工作，所以效率是非常高的。有时侯甚至你感觉不到有任何的延迟。
　　
　　程序有待改进的地方：当然可以加一个压缩单元，发送前先压缩再发送。注意：这里也是有技巧的，就是直接把BMP压缩而不要转换成JPG再压。实验证明：上面程序一幅图像大小大概为40-50KB，如果用LAH压缩算法处理一下便只有8-12KB，这样传输起来就比较快。如果想更快的话，可以采用这样的方法：先抓第一幅图像发送，然后从第二幅开始只发跟前一幅不同区域的图像。外国有一个程序叫Remote Administrator，就是采用这样的方法。他们测试的数据如下：局部网一秒钟100-500幅，互联网上，在网速极低的情况下，一秒钟传输5-10幅。说这些题外话只想说明一个道理：想问题，特别是写程序，特别是看起来很复杂的程序，千万不要钻牛角尖，有时侯不妨换个角度来想。程序是死的，人才是活的。当然，这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的！

投稿人：Boymaster　投稿日期：2002-9-24 17:29:00

在internet上最好是用TCP/IP建立连接后再传

明明是经韬的文章，怎么会成了Boymaster的呢。无耻呀。

无耻。

那么就看我的问题 :
http://www.delphibbs.com/delphibbs/dispq.asp?lid=538683

不管是谁的，同意

注意协议

上面的文章速度不行！
UP

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ExtDlgs, NMSTRM, Psock, ComCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
NMStrmServ1: TNMStrmServ;
NMStrm1: TNMStrm;
StatusBar1: TStatusBar;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
procedure NMStrm1MessageSent(Sender: TObject);
procedure NMStrm1Connect(Sender: TObject);
procedure NMStrm1Disconnect(Sender: TObject);
procedure NMStrm1HostResolved(Sender: TComponent);
procedure NMStrm1Status(Sender: TComponent; Status: String);
procedure NMStrm1PacketSent(Sender: TObject);
procedure NMStrm1InvalidHost(var Handled: Boolean);
procedure NMStrm1ConnectionFailed(Sender: TObject);
procedure NMStrmServ1ClientContact(Sender: TObject);
procedure NMStrmServ1Status(Sender: TComponent; Status: String);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
myfstream:tfilestream;
begin
if form1.OpenDialog1.Execute then
begin
form1.NMStrm1.Host:=edit1.Text;
myfstream:=tFilestream.Create(form1.OpenDialog1.FileName,fmopenread);
try
form1.NMStrm1.PostIt(myfstream);
finally
myfstream.Free;
end;
end;

end;

procedure TForm1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
var
myfstream:Tfilestream;
begin
myfstream:=tfilestream.Create(formatdatetime('yyyymmddhhnnss',now)+'.mpg',fmcreate);

try
myfstream.CopyFrom(strm,strm.size);
finally
myfstream.Free;
end;
end;

procedure TForm1.NMStrm1MessageSent(Sender: TObject);
begin
showmessage('stream sent');
end;

procedure TForm1.NMStrm1Connect(Sender: TObject);
begin
statusbar1.SimpleText:='已连接';
end;

procedure TForm1.NMStrm1Disconnect(Sender: TObject);
begin
if statusbar1<>nil then
statusbar1.SimpleText:='已断开';
end;

procedure TForm1.NMStrm1HostResolved(Sender: TComponent);
begin
statusbar1.SimpleText:='host resolved';
end;

procedure TForm1.NMStrm1Status(Sender: TComponent; Status: String);
begin
if statusbar1<>nil then
statusbar1.SimpleText:=status;
end;

procedure TForm1.NMStrm1PacketSent(Sender: TObject);
begin
statusbar1.SimpleText:=inttostr(nmstrm1.BytesSent)+'of'+inttostr(nmstrm1.BytesTotal)+'sent';
end;

procedure TForm1.NMStrm1InvalidHost(var Handled: Boolean);
var
tmpstr:string;
begin
if inputquery('invalid host!','specify a new host:',tmpstr) then
begin
nmstrm1.Host:=tmpstr;
handled:=true;
end;
end;

procedure TForm1.NMStrm1ConnectionFailed(Sender: TObject);
begin
showmessage('连接失败');
end;

procedure TForm1.NMStrmServ1ClientContact(Sender: TObject);
begin
nmstrmserv1.ReportLevel:=status_basic;
nmstrmserv1.TimeOut:=90000;
statusbar1.SimpleText:='客户端连接';
end;

procedure TForm1.NMStrmServ1Status(Sender: TComponent; Status: String);
begin
if statusbar1<>nil then
statusbar1.SimpleText:=status;
end;

end.

我自己照书作了一个,既可以当客户端也可以当服务端,在局域网传输好用,但在internet
上传输不了,那位朋友帮我看一看错在那里

用Delphi编写点对点传文件程序
基本思路，就是一个服务器软件，一个客户端软件，使用同一个端口，待连接上
以后，客户端给服务器发送一个请求，包括待传的文件的文件名，大小等，如果服务器
接受，就开始传文件。当然，文件传输的时候可以有两种模式，ASCII码和Bin，不过一
般通用Bin 就可以了。基于上面的讨论，本来用Delphi4的NMStrm，NMStrmServ 控件就
可以完成，但是我测试过了，NMStrm控件对于较小的文件还可以使用，而且很方便，但
是如果文件一大(1M)就会出错。所以接下来我们利用Delphi中TServerSocket和TClient
Socket写这个程序由于以太包大小的限制以及DelphiSocket的处理机制(Delphi中，当你
用一个Socket发送一个较大的Stream，接受方会激发多次OnRead事件，Delphi她只保证
多次OnRead事件中每次数据的完整，而不会自己收集数据并返回给用户。所以不要以为
你把待传文件在一个Socket中Send一次，另一个中Recv一次就可以了。你必须自己收集
数据或自己定义协议。)，所以我们采用自定义协议的方法。定义协议的规范方法是利用
Record End。如：
TMyFileProtocol=Record
sSendType=(ST_QUERY,ST_REFUSE,ST_DATA,ST_ABORT,...);
iLength:integer;
bufSend:Buffer;
End;
　　我曾试过这个办法，但失败了，而且我一直认为我的方法是正确的，但程序一直编
译通不过，估计是Delphi有问题 所以我在下列的范例程序中利用另外一种办法。Soc
ket 类中有两属性ReceiveText和ReceiveBuf，在一个OnRead事件中，只能使用一次该两
属性，所以我们可以利用一个全程变量来保存是该读Text还是Buf，也就是说读一次Tex
t，再都一次Buf，这就模拟了TMyFileProtocol。
开始程序：
写一个最简单的，主要用于讲解方法。
定义协议：
Const
MP_QUERY ='1';
MP_REFUSE ='2';
MP_ACCEPT ='3';
MP_NEXTWILLBEDATA='4';
MP_DATA ='5';
MP_ABORT ='6';
MP_OVER ='7';
MP_CHAT ='8';
协议简介：
首先由Client发送MP_QUERY，Server接受到后发送MP_ACCEPT或MP_FEFUESE；
Client接受到MP_ACCEPT发送MP_FILEPROPERTY，Server接受到后发送MP_NEXTWILLBEDAT
A；
Client接受到发送MP_NEXTWILLBEDATA，Server接受到后发送MP_DATA；
Client接受到MP_DATA，发送数据，Server接受数据，并发送MP_NEXTWILLBEDATA；
循环，直到Client发送MP_OVER；
中间可以互相发送MP_CHAT+String；
Server程序：
放上以下控件:SaveDialog1,btnStartServer,
ss,(TServerSocket)
btnStartServer.OnClick(Sender:TObject);
begin
ss.Port:=2000;
ss.Open;
end;
ss.OnClientRead(Sender: TObject;Socket: TCustomWinSocket);
var
sTemp:string;
bufRecvointer;
iRecvLength:integer;
begin
if bReadText then
begin
sTemp:=Socket.ReceiveText;
case sTemp[1] of
MP_QUERY:begin
//在这里拒绝
SaveDialog1.FileName:=Copy(sTemp,2,Length(STemp));
if SaveDialog1.Execute then
begin
Socket.SendText(MP_ACCEPT);
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
end
else Socket.SendText(MP_REFUSE+'去死');
end;
MP_FILEPROPERTY:begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
Socket.SendText(MP_NEXTWILLBEDATA);
end;
MP_NEXTWILLBEDATA:begin
Socket.SendText(MP_DATA);
bReadText:=false;
end;
MP_END:begin
fsRecv.Free
bReadText:=true;
end;
MP_ABORT:begin
fsRecv.Free;
bReadText:=true;
end;
MP_CHAT:begin
//Chat Msg
end;
end;{of case}
end
else begin
try
GetMem(bufRecv,2000);//2000 must >iBYTESEND
Socket.ReceiveBuf(bufRecv^,iRecvLength);
fsRecv.WriteBuffer(bufRecv^,iRecvLength);
finally
FreeMem(bufRecv,2000);
end;{of try}
bReadText:=true;
Socket.SendText(MP_NEXTWILLBEDATA);
end;
end;
Client程序：
放上以下控件：edtIPAddress,OpenDialog1,btnConnect,btnSendFile,
cs. (TClientSocket)
btnConnect.OnClick(Sender:TObject);
begin
cs.Address:=edtIPAddress.Text;
cs.Port:=2000;
cs.Connect;
end;
btnSendFile.OnClick(Sender:TObject);
begin
if OpenDialog1.Execute then
Begin
cs.Socket.SendText(MP_QUERY+OpenDialog1.FileName);//FileSize???
end;
end;
cs.OnRead(Sender: TObject;Socket: TCustomWinSocket);
var
sTemp:string;
bufSendointer;
begin
sRecv:=Socket.ReceiveText;
Case sRecv[1] of
MP_REFUSE:ShowMessage('Faint,be refused!');
MP_ACCEPT:begin
fsSend:=TFileStream.Create(OpenDialog1.FileName,fmOpen);
//iBYTEPERSEND是个常量，每次发送包的大小。
Socket.SendText(MP_FILEPROPERTY+Trunc(fsSend.Size/iBYTEPERSEND)+1);
end;
MP_NEXTWILLBEDATA:begin
Socket.SendText(MP_NEXTWILLBEDATA);
end;
MP_DATA:begin
try
GetMem(bufSend,iBYTEPERSEND+1);
if (fsSend.Position+1+iBYTEPERSEND) < fsSend.Size then
begin
fsSend.Read(bufSend^,iBYTEPERSEND);
Socket.SendBuf(bufSend^,iBYTEPERSEND);
fsSend.Free;
end//普通的发送，大小为iBYTEPERSEND
else begin
fsSend.Read(bufSend^,fsSend.Size-fsSend.Position-1);
Socket.SendBuf(bufSend^,fsSend.Size-fsSend.Position-1);
end;//最后一次发送，发送剩余的数据
finally
FreeMem(bufSend,iBYTEPERSEND+1);
end;{of try}
end;
MP_ABORT:begin
//被取消了
fsSend.Free;
end;
end;{of case}
end;
整理程序：
　　加入错误判断，优化程序，把Server和Client联合在一起，加入剩余时间进度显示
，做成能一次传多个文件，加入聊天功能，就成了一个很好的点对点传文件的程序。

up

up

gz

up

up

up