求源码(用INDY控件传文件)!!!倾出全部分数。(100分)

  • 主题发起人 主题发起人 samen
  • 开始时间 开始时间
S

samen

Unregistered / Unconfirmed
GUEST, unregistred user!
用IDTCPSERVER 与IDTCPCLIENT传文件的代码。
 
看一下delphi下的demo吧,里面有一个用INDY做流传输的例子,只要改一下就可以了!
 
发送端
procedure TForm1.Button2Click(Sender: TObject);
var
buf:tfilestream;
begin
buf := TFileStream.Create(edit5.Text, fmOpenRead);//edit5.text文件名(含路径)
IdTCPClient1.Host:=edit1.Text;//ip string;
IdTCPClient1.Port:=1053;
IdTCPClient1.Connect();
IdTCPClient1.WriteLn(ExtractFileName(edit5.Text));
IdTcpClient1.WriteStream(buf,true,true); //发送文件
IdTcpClient1.Disconnect;
buf.Free;
end;
接收端
procedure Tfm_main.IdTCPServer1Execute(AThread: TIdPeerThread);
var
buf: TFileStream;
FileName:string;
size:longint;
begin
// IdTCPServer1.Bindings:='0.0.0.0:1053'
// IdTCPServer1.active:=true; //预先在属性设置好
FileName:=athread.Connection.ReadLn;
buf := TFileStream.Create(FileName, fmCreate);
AThread.Connection.ReadStream(buf, -1, true);
buf.Free;
end;
 
client:
{TT8(scott huang ,XiaMen,China) 2003.07.11 INDY TcpServer,TcpClient 上传文件实例
仅供参考 如果造成你的什么损失 我一概不管。
如果你有更好的主意,请把修改好(或则全新)的源程序发到 tt8tt8@21cn.com 供我参考
}
unit client;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, FileCtrl,inifiles;

type
TForm2 = class(TForm)
TCPClient: TIdTCPClient;
ProgressBar1: TProgressBar;
CurNum: TLabel;
TolNum: TLabel;
BeginUpdate: TButton;
EdPort: TEdit;
LogMemo: TMemo;
EdHost: TEdit;
ListBox1: TListBox;
SelectFIle: TButton;
OpenDialog1: TOpenDialog;
Label1: TLabel;
procedure TCPClientWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure TCPClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure BeginUpdateClick(Sender: TObject);
procedure SelectFIleClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;
myinifile:Tinifile;

implementation


{$R *.dfm}

procedure TForm2.TCPClientWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AWorkMode = wmWrite then
begin
CurNum.Caption := IntToStr(AWorkCount);
ProgressBar1.Position := AWorkCount;
Update;
end;

end;

procedure TForm2.TCPClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
TolNum.Caption := InttoStr(StrToInt(TolNum.Caption)+StrToInt(CurNum.Caption));
update;
end;

procedure TForm2.BeginUpdateClick(Sender: TObject);
var
FileStream: TFileStream;
FIleSize: Int64;
i: Integer;
flag:boolean;
begin
if listbox1.Count<=0 then
begin
showmessage('Please select files first.');
exit;
end;
with TCPClient do
begin
Port := StrToInt(EdPort.Text);
Host := EdHost.Text;
if not Connected then
begin
try
Connect;
except
LogMemo.Lines.Add('上传服务没有开启!');
exit;
end;
end;

for i := 0 to ListBox1.Items.Count-1 do
begin
WriteLn(listbox1.items);
flag:=true;
try
FileStream := TFileStream.Create(listbox1.items,fmOpenRead);
FileSize := FileStream.Size;
ProgressBar1.Max:=FileSize;
ProgressBar1.Position:=0;
WriteStream(FileStream,True,True,FileSize);
except
Flag:=false;
end;
FileStream.Free;
if flag then
LogMemo.Lines.add(DateTimeToStr(Now)+'上传'+listbox1.items+' Success')
else
LogMemo.Lines.add(DateTimeToStr(Now)+'上传'+listbox1.items+' error.');
end;
// LogMemo.Lines.add(DateTimeToStr(Now)+'上传正常完成!');
end;
end;

procedure TForm2.SelectFIleClick(Sender: TObject);
var i:integer;
begin
// showmessage(opendialog1.InitialDir);
if opendialog1.execute=true then
with opendialog1 do
begin
if files.count>0 then //选择了文件
begin
listbox1.clear;
for i:=0 to files.count-1 do
if fileexists(Files) then
listbox1.items.add(Files);
end;
end;
end;


procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TCPClient.disconnect;
myinifile.writestring('FileTransClient','Host',edHost.Text);
myinifile.writestring('FileTransClient','Port',edPort.Text);
myinifile.Destroy;
end;

procedure TForm2.FormCreate(Sender: TObject);
var FileName:string;
begin
Filename:=ExtractFilePath(Paramstr(0))+'client.ini';
myinifile:=Tinifile.Create(filename);
edHost.Text:=myinifile.Readstring('FileTransClient','Host','127.0.0.1');
edPort.Text:=myinifile.Readstring('FileTransClient','Port','6123');
opendialog1.InitialDir:=myinifile.Readstring('FileTransClient','InitialDir','');
end;

end.

server:
{TT8(scott huang ,XiaMen,China) 2003.07.11 INDY TcpServer,TcpClient 上传文件实例
仅供参考 如果造成你的什么损失 我一概不管。
如果你有更好的主意,请把修改好(或则全新)的源程序发到 tt8tt8@21cn.com 供我参考
}

unit server;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer;

type
TForm1 = class(TForm)
TCPServer: TIdTCPServer;
LogMemo: TMemo;
EdPort: TEdit;
StartServer: TButton;
StopServer: TButton;
Label1: TLabel;
procedure StartServerClick(Sender: TObject);
procedure StopServerClick(Sender: TObject);
procedure TCPServerExecute(AThread: TIdPeerThread);
procedure TCPServerConnect(AThread: TIdPeerThread);
procedure TCPServerDisconnect(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.StartServerClick(Sender: TObject);
begin
with TCPServer do
begin
Active := False;
DefaultPort := StrToInt(EdPort.Text);
Active := True;
LogMemo.Lines.Add(DateTimeToStr(Now)+' 服务已经启动!(Port: '+EdPort.Text+')');
end;
end;

procedure TForm1.StopServerClick(Sender: TObject);
begin
with TCPServer do
begin
Active := False;
LogMemo.Lines.Add(DateTimeToStr(Now)+' 服务已经停止!');
end;
end;

procedure TForm1.TCPServerExecute(AThread: TIdPeerThread);
var
FileStream: TFileStream;
FileStr: String;
flag:boolean;
begin
with AThread.Connection do
begin
while Connected do
begin
FileStr := 'upload/'+extractfilename(ReadLn);
LogMemo.Lines.Add(datetimetostr(now)+' Receiveing file:'+FileStr);
flag:=true;
try
FileStream := TFileStream.Create(FileStr,fmCreate);
ReadStream(FileStream,-1,False);
except
flag:=false
end;
fileStream.Free;
if flag then
LogMemo.Lines.Add(datetimetostr(now)+' ok.')
else LogMemo.Lines.Add(datetimetostr(now)+' fail.');
end;
end;
end;


procedure TForm1.TCPServerConnect(AThread: TIdPeerThread);
begin
LogMemo.Lines.Add('connected:'+Athread.Connection.Socket.Binding.PeerIP);
end;

procedure TForm1.TCPServerDisconnect(AThread: TIdPeerThread);
begin
LogMemo.Lines.Add('Disconnected:'+Athread.Connection.Socket.Binding.PeerIP);end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//TransFiles Client 2003.07.11 Provided by TT8(scott huang,Xiamen,China)
end;

end.
 
后退
顶部