求internet上点对点传输图片的源码(100分)

  • 主题发起人 主题发起人 jinzhengang
  • 开始时间 开始时间
J

jinzhengang

Unregistered / Unconfirmed
GUEST, unregistred user!
两台机器通过猫拨号上网,不通过代理服务器和局域网上网,没有防火墙.求实用一点的源码
请各位高手帮忙了.我的邮箱 jzg-27@163.com
 
用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;
bufRecv:Pointer;
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;
bufSend:pointer;
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联合在一起,加入剩余时间进度显示
,做成能一次传多个文件,加入聊天功能,就成了一个很好的点对点传文件的程序。
 
各位朋友帮帮忙呀,发扬一下富翁精神,帮助一下。
 
我讲一下个人思路,我得程序远程传输学生的照片就是通过这种方法实现的。
说白了跟传送普通的文件一样,通过socket或udp传输。方法可行。
 
http://www.playicq.com/dispdoc.php?t=&id=1054
点对点传输控件源码 For D5D6
 
服务端

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ExtDlgs,Winsock, 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}


function GetLocalIP:String;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I: Integer;
GInitData: TWSADATA;
begin
WSAStartup($101, GInitData);
try
Result:='';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^ <> nil do
begin
result:=StrPas(inet_ntoa(pptr^^));
Inc(I);
end;
finally
WSACleanup;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Text:=GetLocalIP;
end;

procedure TForm1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
var
myfstream:Tfilestream;
begin
myfstream:=tfilestream.Create(formatdatetime('yyyymmddhhnnss',now)+'.jpg',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.

客户端

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.
 
各位帮帮忙吧
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部