(死亡历险)Delphi7 IdTCPClient1,IdTCPServer1客户端向服务端传送大型文件
来源:互联网 发布:centos 迅雷 编辑:程序博客网 时间:2024/06/10 19:54
服务端
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, ExtCtrls, Buttons,
StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
host: TEdit;
port: TEdit;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
SaveDialog1: TSaveDialog;
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
rbyte:array[0..4096] of byte;
sFile:TFileStream;
//cnt:integer;
cmd,FileSize:integer;
str,FileName:string;
begin
if not AThread.Terminated and AThread.Connection.Connected then //注意这里
begin
with AThread.Connection do
begin
Try
str:=AThread.Connection.ReadLn; //接收文件大小及文件名
cmd:=pos('|',str); //查找分隔符
FileName:=copy(str,1,cmd-1); //提取文件名
FileSize:=StrToInt(copy(str,cmd+1,Length(str)-cmd+1)); //提取文件大小
//if MessageBox(0,Pchar('用户'+AThread.Connection.Socket.Binding.PeerIP+'要给您传送文件 "'+FileName+'" 您是接受还是拒绝?'),'文件接受',MB_YesNo or MB_ICONQUESTION)=ID_Yes then //询问是否接收
//begin
//ProgressBar1.Max:=FileSize; //初始化进度条
//ProgressBar1.Position:=0;
//SaveDialog1.FileName:=FileName; //指定保存的默认文件名,一定要在 SaveDialog1.Execute;之前,不然文件名为空
//SaveDialog1.Execute;
//sFile:=TFileStream.Create(SaveDialog1.FileName,fmCreate); //创建待写入的文件流
sFile:=TFileStream.Create(ExtractFilePath(ParamStr(0))+'\'+FileName,fmCreate);
While FileSize>4096 do
begin
Application.ProcessMessages;
AThread.Connection.ReadBuffer(rbyte,4096);// 读取文件流
sFile.Write(rByte,4096); //写入文件流
//cnt:=AThread.Connection.ReadInteger; //从发送端接收最新的进度位置信息
//ProgressBar1.Position:=ProgressBar1.Position+cnt; //更新显示进度
//StatusBar1.Panels[0].Text:='正在接收文件中...';
Memo1.Lines.Add('正在接收文件中...'+DateTimeToStr(Now));
inc(FileSize,-4096);
end;
AThread.Connection.ReadBuffer(rbyte,FileSize);// .ReadBuffer(rbyte,iLen);
sFile.Write(rByte,FileSize);
sFile.Free;
Memo1.Lines.Add('文件接收完成!'+DateTimeToStr(Now));
//end;
Finally
//Disconnect;//断开连接
end;
end;
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
IdTCPServer1.Bindings.Clear;
IdTCPServer1.Bindings.Add.IP:=host.Text;//'192.168.252.1';
IdTCPServer1.Bindings.Add.Port:=StrToInt(port.Text);//8830;
IdTCPServer1.Active:=true;
if IdTCPServer1.Active then
begin
Memo1.Lines.Add('Server running');
end
else
begin
Memo1.Lines.Add('Server stop');
end;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
IdTCPServer1.Destroy;
Memo1.Lines.Add('Server stop');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SpeedButton1Click(Sender);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
IdTCPServer1.Active:=False;
Application.Terminate;
end;
-----------------------------------------------------
客户端
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
ComCtrls, StdCtrls, Buttons;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
SpeedButton2: TSpeedButton;
SpeedButton1: TSpeedButton;
host: TEdit;
port: TEdit;
Memo1: TMemo;
edtFileName: TEdit;
IdTCPClient1: TIdTCPClient;
OpenDialog1: TOpenDialog;
SpeedButton3: TSpeedButton;
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
SpeedButton3Click(Sender);
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
OpenDialog1.Execute;
edtFileName.Text:=OpenDialog1.FileName;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
iFileHandle:integer;
iFileLen,cnt:integer;
buf:array[0..4096] of byte;
begin
iFileHandle:=FileOpen(edtFileName.Text,fmOpenRead);
iFileLen:=FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
ProgressBar1.Max:=iFileLen;
ProgressBar1.Position := 0;
IdTCPClient1.WriteLn(ExtractFileName(edtFileName.Text)+'|'+IntToStr(iFileLen));
while true do
begin
Application.ProcessMessages;
cnt:=FileRead(iFileHandle,buf,4096);
IdTCPClient1.WriteBuffer(buf,cnt);
//IdTCPClient1.WriteInteger(cnt);
ProgressBar1.Position:=ProgressBar1.Position + cnt;
Memo1.Lines.Add('正在传送文件...'+DateTimeToStr(Now));
if cnt<4096 then
break;
end;
FileClose(iFileHandle);
Memo1.Lines.Add('文件传送完成!'+DateTimeToStr(Now));
SpeedButton3Click(Sender);
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
Memo1.Lines.Add('已连接');
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
IdTCPClient1.Host:=host.Text;//'192.168.252.1';
IdTCPClient1.Port:=StrToInt(port.Text);//8829;
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
Try
IdTCPClient1.Connect;
except
MessageBox(Handle,'服务器没有开启','提示',MB_OK);
Exit;
end;
end;
end.
0 0
- (死亡历险)Delphi7 IdTCPClient1,IdTCPServer1客户端向服务端传送大型文件
- (死亡历险)Delphi7 IdTCPClient1,IdTCPServer1客户端向服务端发送指令进行文件下载
- 客户端IdTCPClient向服务端IdTCPServer1发送消息
- GUI界面,客户端向服务端传送文件
- (死亡历程)Delphi7 自带的控件 IdTCPClient,IdTCPServer 客户端发送给服务端,服务端转发给其它客户端
- 客户端向服务端传输文件(2)
- java服务端客户端交互系列(四)传送任意文件(服务端并发)
- Android 手机间的文件传送(socket手机做服务端和客户端进行)
- 线程Socket传送文件的客户端和服务端源代码
- TCP协议从客户端传送文件给服务端
- c语言实现socket服务端/客户端通过tcp传送文件
- Javascript向客户端传送脚本
- 导入EXCEL到数据库并删除EXCEL文件(死亡历险)
- java实现的客户端向服务端上传文件的程序
- web客户端 向 wcf rest服务端 上传文件
- 客户端向服务端发送信息
- windows向linux传送文件
- 主机向虚拟机传送文件
- 用html5 js实现浏览器全屏
- 网络信息安全攻防学习平台——基础关
- contiguous/flush/informed
- 关于Activity的getReferrer()之二:调用者的包名是如何传给mReferrer的,兼谈startActivity的详细流程
- 解决Xshell无法运行问题
- (死亡历险)Delphi7 IdTCPClient1,IdTCPServer1客户端向服务端传送大型文件
- lxml模块安装失败
- 十二月状态总结
- qt 出现 error: 'setCodecForTr' is not a member of 'QTextCodec'等错误的请进..
- javascript中的闭包概念
- Leetcode 437. Path Sum III (Easy) (cpp)
- 微星GS73VR 6RF + Linux Mint 18 + GTX1060 + CUDA8.0 + OpenCV3.0.0 + Caffe安装笔记
- Windows 安装 cuteFTP 9.0 并破解
- 配置多个git远程仓库的ssh-Key切换