indy 文件传送的问题 ( 积分: 300 )

  • 主题发起人 主题发起人 饮茶
  • 开始时间 开始时间
饮

饮茶

Unregistered / Unconfirmed
GUEST, unregistred user!
用文件流加indy实现文件传送
procedure TForm1.N4Click(Sender: TObject);
var
source:Tfilestream;
begin
tcpserver.Active:=true;
tcpclient.Host:=inputbox('Inputbox','IP 地址 ','255.255.255.255');
try
tcpclient.Connect(6000);
except on E:eidsocketerror do
showmessage(E.Message);
end;
if tcpclient.Connected then
begin
if opendialog1.Execute then
begin
source:=tfilestream.Create(opendialog1.FileName,fmcreate);
tcpclient.WriteStream(source,true,true);
source.Free ;
end;
tcpclient.Disconnect ;
end;
end;

procedure TForm1.Tcpserver_Execute(AThread: TIdPeerThread);
var
des:tfilestream;
begin
if savedialog1.Execute then
begin
des:=tfilestream.Create(savedialog1.FileName,fmopenwrite);
athread.Connection.ReadStream(des,-1,true);
athread.Connection.Disconnect ;
des.Free ;
end;
end;
ip 端口都设好了 为什么服务端总是没反应 高手请帮忙改一下 或直接传给我一个可以用的文件传送源代码(用indy)，我的邮箱是yuyongjian1314@163.com 先谢谢了 高分送高手了
 
下面是源代码,服务器和客户端在一个UNIT1中,经测试可用,你研究一下,不一定能对得上你的INDY版本.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdTCPServer, StdCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, ComCtrls, IdAntiFreezeBase, IdAntiFreeze;

type
TForm1 = class(TForm)
IdTCPClient1: TIdTCPClient;
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
ListBox1: TListBox;
Button2: TButton;
Button3: TButton;
Label2: TLabel;
Edit2: TEdit;
Button4: TButton;
OpenDialog1: TOpenDialog;
IdTCPServer1: TIdTCPServer;
SaveDialog1: TSaveDialog;
Button5: TButton;
Button6: TButton;
Label3: TLabel;
ProgressBar1: TProgressBar;
IdAntiFreeze1: TIdAntiFreeze;
Button7: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure Button5Click(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure Button7Click(Sender: TObject);


private
//fsSend: TFileStream;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
xcfilename:string;
xcsavestream:tfilestream;
xcpos:integer;


implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPServer1.Active := True;
Button1.Enabled := False;
Button2.Enabled := False;
listbox1.Items.Add('服务器已成功启动！');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Edit1.Text='' then
begin
ShowMessage('服务器IP不能为空');
Exit;
end;
IdTCPClient1.Host:=edit1.Text;
listbox1.Items.Add('正在连接远程主机IP: ' + Edit1.Text );
with IdTCPClient1 do
begin
try
Connect;
try
listbox1.Items.Add(ReadLn());
Button1.Enabled := False;
except
listbox1.Items.Add('远程主机无响应！');
IdTCPClient1.Disconnect();
end;
except
listbox1.Items.Add('无法建立到远程主机' + Edit1.Text + '的连接！');
end;//end try
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
listbox1.Items.Add('QUIT');
try
IdTCPClient1.WriteLn('QUIT');
finally
IdTCPClient1.Disconnect();
listbox1.Items.add('同主机 ' + Edit1.Text + ' 的连接已断开！');
Button1.Enabled := True;
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
opendialog1:=topendialog.Create(self);
if opendialog1.Execute then
begin
edit2.Text:=opendialog1.Filename;
button5.Enabled:=true;
end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
IdTCPServer1.Active := False;
idtcpclient1.Disconnect;
form1.Close;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
listbox1.Items.Add('来自主机 '+ AThread.Connection.Socket.Binding.PeerIP+ ' 的连接请求已被接纳！');
AThread.Connection.WriteLn('欢迎连接到简单TCP服务器');
end;

procedure TForm1.Button5Click(Sender: TObject);
var
buf:array[0..1023] of byte;
filename,state:string;
filelen,readcount,pos:integer;
openstream:tfilestream;
begin
openstream:=tfilestream.Create(opendialog1.FileName,fmopenread or fmShareDenyWrite);
filename:=ExtractFileName(opendialog1.FileName);
idtcpclient1.WriteLn(filename);
state:=IdTCPClient1.ReadLn();
if state<>'xc' then
begin
try
listbox1.Items.Add('开始传送文件');
filelen:=openstream.Size;
idtcpclient1.WriteBuffer(filelen,4);
progressbar1.Max:=filelen;
while openstream.Position<openstream.Size do
begin
if openstream.Size-openstream.Position>=sizeof(buf) then
readcount:=sizeof(buf)
else
readcount:=openstream.Size-openstream.Position;
openstream.ReadBuffer(buf,readcount);
idtcpclient1.WriteBuffer(buf,readcount);
progressbar1.Position:=openstream.Position;
idtcpclient1.ReadLn(#13#10, 100);
Application.ProcessMessages;
end;
listbox1.Items.Add('文件传送完毕');
finally
openstream.Free;
end
end;
if state='xc' then
begin
try
listbox1.Items.Add('开始续传文件'+opendialog1.FileName);
filelen:=openstream.Size;
idtcpclient1.WriteBuffer(filelen,4);
idtcpclient1.ReadBuffer(pos,4);
openstream.Position:=pos;
progressbar1.Max:=filelen;
while openstream.Position<openstream.Size do
begin
if openstream.Size-openstream.Position>=sizeof(buf) then
readcount:=sizeof(buf)
else
readcount:=openstream.Size-openstream.Position;
openstream.ReadBuffer(buf,readcount);
idtcpclient1.WriteBuffer(buf,readcount);
progressbar1.Position:=openstream.Position;
idtcpclient1.ReadLn(#13#10, 100);
Application.ProcessMessages;
end;
listbox1.Items.Add('文件传送完毕');
finally
openstream.Free;
end
end;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
buf:array[0..1023] of byte;
savestream: TFileStream;
filename:string;
filelen,ReadCount:Integer;
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
filename:=AThread.Connection.ReadLn();
if filename='' then
exit;
if filename<>xcfilename then
begin
savedialog1.FileName:=filename;
if savedialog1.Execute then
begin
AThread.Connection.WriteLn('wj');
athread.Connection.ReadBuffer(filelen,4);
progressbar1.Max:=filelen;
savestream:=tfilestream.Create(savedialog1.FileName,fmcreate);
listbox1.Items.Add('开始接收');
end;
try
repeat
if filelen-savestream.Position>sizeof(buf) then
ReadCount := SizeOf(Buf)
else
ReadCount :=filelen-savestream.Position;
AThread.Connection.ReadBuffer(Buf, ReadCount);
saveStream.WriteBuffer(Buf, ReadCount);
progressbar1.Position:=savestream.Position;
athread.Connection.WriteLn();
Application.ProcessMessages;
until saveStream.size >= Filelen;
except
xcfilename:=filename;
xcsavestream:=savestream;
xcpos:=savestream.Position;
listbox1.Items.Add('连接中断');
//AThread.Connection.WriteLn('OK');
end
end;
if filename=xcfilename then
begin
athread.Connection.WriteLn('xc');
athread.Connection.ReadBuffer(filelen,4);
progressbar1.Max:=filelen;
athread.Connection.WriteBuffer(xcpos,4);
savestream:=xcsavestream;
savestream.Position:=xcpos;
try
repeat
if filelen-savestream.Position>sizeof(buf) then
ReadCount := SizeOf(Buf)
else
ReadCount :=filelen-savestream.Position;
AThread.Connection.ReadBuffer(Buf, ReadCount);
saveStream.WriteBuffer(Buf, ReadCount);
progressbar1.Position:=savestream.Position;
athread.Connection.WriteLn();
Application.ProcessMessages;
until saveStream.size >= Filelen;
listbox1.Items.Add('传输完成');
xcfilename:='';
except
xcfilename:=filename;
xcsavestream:=savestream;
xcpos:=savestream.Position;
end
end;
end;
savestream.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
button5.Enabled:=false;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
form2.ShowModal;
end;

end.
 
下面是源代码,服务器和客户端在一个UNIT1中,经测试可用,你研究一下,不一定能对得上你的INDY版本.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdTCPServer, StdCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, ComCtrls, IdAntiFreezeBase, IdAntiFreeze;

type
TForm1 = class(TForm)
IdTCPClient1: TIdTCPClient;
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
ListBox1: TListBox;
Button2: TButton;
Button3: TButton;
Label2: TLabel;
Edit2: TEdit;
Button4: TButton;
OpenDialog1: TOpenDialog;
IdTCPServer1: TIdTCPServer;
SaveDialog1: TSaveDialog;
Button5: TButton;
Button6: TButton;
Label3: TLabel;
ProgressBar1: TProgressBar;
IdAntiFreeze1: TIdAntiFreeze;
Button7: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure Button5Click(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure Button7Click(Sender: TObject);


private
//fsSend: TFileStream;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
xcfilename:string;
xcsavestream:tfilestream;
xcpos:integer;


implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPServer1.Active := True;
Button1.Enabled := False;
Button2.Enabled := False;
listbox1.Items.Add('服务器已成功启动！');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Edit1.Text='' then
begin
ShowMessage('服务器IP不能为空');
Exit;
end;
IdTCPClient1.Host:=edit1.Text;
listbox1.Items.Add('正在连接远程主机IP: ' + Edit1.Text );
with IdTCPClient1 do
begin
try
Connect;
try
listbox1.Items.Add(ReadLn());
Button1.Enabled := False;
except
listbox1.Items.Add('远程主机无响应！');
IdTCPClient1.Disconnect();
end;
except
listbox1.Items.Add('无法建立到远程主机' + Edit1.Text + '的连接！');
end;//end try
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
listbox1.Items.Add('QUIT');
try
IdTCPClient1.WriteLn('QUIT');
finally
IdTCPClient1.Disconnect();
listbox1.Items.add('同主机 ' + Edit1.Text + ' 的连接已断开！');
Button1.Enabled := True;
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
opendialog1:=topendialog.Create(self);
if opendialog1.Execute then
begin
edit2.Text:=opendialog1.Filename;
button5.Enabled:=true;
end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
IdTCPServer1.Active := False;
idtcpclient1.Disconnect;
form1.Close;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
listbox1.Items.Add('来自主机 '+ AThread.Connection.Socket.Binding.PeerIP+ ' 的连接请求已被接纳！');
AThread.Connection.WriteLn('欢迎连接到简单TCP服务器');
end;

procedure TForm1.Button5Click(Sender: TObject);
var
buf:array[0..1023] of byte;
filename,state:string;
filelen,readcount,pos:integer;
openstream:tfilestream;
begin
openstream:=tfilestream.Create(opendialog1.FileName,fmopenread or fmShareDenyWrite);
filename:=ExtractFileName(opendialog1.FileName);
idtcpclient1.WriteLn(filename);
state:=IdTCPClient1.ReadLn();
if state<>'xc' then
begin
try
listbox1.Items.Add('开始传送文件');
filelen:=openstream.Size;
idtcpclient1.WriteBuffer(filelen,4);
progressbar1.Max:=filelen;
while openstream.Position<openstream.Size do
begin
if openstream.Size-openstream.Position>=sizeof(buf) then
readcount:=sizeof(buf)
else
readcount:=openstream.Size-openstream.Position;
openstream.ReadBuffer(buf,readcount);
idtcpclient1.WriteBuffer(buf,readcount);
progressbar1.Position:=openstream.Position;
idtcpclient1.ReadLn(#13#10, 100);
Application.ProcessMessages;
end;
listbox1.Items.Add('文件传送完毕');
finally
openstream.Free;
end
end;
if state='xc' then
begin
try
listbox1.Items.Add('开始续传文件'+opendialog1.FileName);
filelen:=openstream.Size;
idtcpclient1.WriteBuffer(filelen,4);
idtcpclient1.ReadBuffer(pos,4);
openstream.Position:=pos;
progressbar1.Max:=filelen;
while openstream.Position<openstream.Size do
begin
if openstream.Size-openstream.Position>=sizeof(buf) then
readcount:=sizeof(buf)
else
readcount:=openstream.Size-openstream.Position;
openstream.ReadBuffer(buf,readcount);
idtcpclient1.WriteBuffer(buf,readcount);
progressbar1.Position:=openstream.Position;
idtcpclient1.ReadLn(#13#10, 100);
Application.ProcessMessages;
end;
listbox1.Items.Add('文件传送完毕');
finally
openstream.Free;
end
end;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
buf:array[0..1023] of byte;
savestream: TFileStream;
filename:string;
filelen,ReadCount:Integer;
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
filename:=AThread.Connection.ReadLn();
if filename='' then
exit;
if filename<>xcfilename then
begin
savedialog1.FileName:=filename;
if savedialog1.Execute then
begin
AThread.Connection.WriteLn('wj');
athread.Connection.ReadBuffer(filelen,4);
progressbar1.Max:=filelen;
savestream:=tfilestream.Create(savedialog1.FileName,fmcreate);
listbox1.Items.Add('开始接收');
end;
try
repeat
if filelen-savestream.Position>sizeof(buf) then
ReadCount := SizeOf(Buf)
else
ReadCount :=filelen-savestream.Position;
AThread.Connection.ReadBuffer(Buf, ReadCount);
saveStream.WriteBuffer(Buf, ReadCount);
progressbar1.Position:=savestream.Position;
athread.Connection.WriteLn();
Application.ProcessMessages;
until saveStream.size >= Filelen;
except
xcfilename:=filename;
xcsavestream:=savestream;
xcpos:=savestream.Position;
listbox1.Items.Add('连接中断');
//AThread.Connection.WriteLn('OK');
end
end;
if filename=xcfilename then
begin
athread.Connection.WriteLn('xc');
athread.Connection.ReadBuffer(filelen,4);
progressbar1.Max:=filelen;
athread.Connection.WriteBuffer(xcpos,4);
savestream:=xcsavestream;
savestream.Position:=xcpos;
try
repeat
if filelen-savestream.Position>sizeof(buf) then
ReadCount := SizeOf(Buf)
else
ReadCount :=filelen-savestream.Position;
AThread.Connection.ReadBuffer(Buf, ReadCount);
saveStream.WriteBuffer(Buf, ReadCount);
progressbar1.Position:=savestream.Position;
athread.Connection.WriteLn();
Application.ProcessMessages;
until saveStream.size >= Filelen;
listbox1.Items.Add('传输完成');
xcfilename:='';
except
xcfilename:=filename;
xcsavestream:=savestream;
xcpos:=savestream.Position;
end
end;
end;
savestream.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
button5.Enabled:=false;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
form2.ShowModal;
end;

end.
 
用IdTCPServer/IdTCPClient控件实现发送文件的Demo
简介：
个简单的Demo，实现在客户端和服务器之间传送文件的功能。
http://www.2ccc.com/article.asp?articleid=3868

IdTCPClient/Server反向传输的例子
简介：
本Demo展示：

1,在服务器端如何维护已经登录的用户列表；
2,反向通讯，通过服务器端给客户端发送文件；
3,实现客户端与服务器端的Chat聊天功能（稍加改动可转化为C->S->C的聊天程序）
4,如何使用IdTCPServer和IdTCPClient控件
5,初步实现线程命令方式，在传送文件的时候不会让服务器端停止响应
http://www.2ccc.com/article.asp?articleid=3894

编译上面的例子需要用到Indy DevSnapshot 快照版。最新的快照版在这里可下载到：
Indy Snapshot v2007-5-8 (快照版)
http://www.2ccc.com/article.asp?articleid=4100

以上内容供楼主参考。
 
能不能给写个精练一点的
 
第一个例子最精炼了，只有文件传输的功能。
 
缺文件编译不了
 
我最近发现indy的前面的版本总出问题,直到我找到10.1.5的才正常. 楼主要的话给我联系 cdk0501@126.com
 
饮茶：
>>缺文件编译不了

请用快照版（我上面都给了你连接了）

墨剑：
>>我最近发现indy的前面的版本总出问题,直到我找到10.1.5的才正常. 楼主要的话给我联系 cdk0501@126.com

Indy最新版本是10.1.6。已经比较稳定了。
 
您必须登录或注册才可回复。

Similar threads

S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
saving raw html source from TWEbbrowser
回复
0
查看
664
import
I
I
文件的合并和分解
回复
0
查看
686
import
I
I
检查文件是否为文本文件
回复
0
查看
662
import
I
后退
顶部