文档章节

Indy 10 文件传输

vga
 vga
发布于 2017/08/04 08:10
字数 821
阅读 16
收藏 0

客户端

procedure TfrmClient.btnSaveClick(Sender: TObject);
var
    cmd:String; //服务器通信命令
    ASize,TotalSize:Int64;//缓冲区大小,文件流大小
    AFileStream:TFileStream;//文件流变量
begin
    IdTCPClient1.Host:=Edit1.Text;
    IdTCPClient1.Port:=StrToIntDef(Edit2.Text,9225);
    IdTCPClient1.Connect;
    Try
      IdTCPClient1.IOHandler.WriteLn('BEGIN');//提示客户端开始接收
      cmd:=IdTCPClient1.IoHandler.ReadLn;
      //以'|'分离文件名
      dlgSave.FileName:=Copy(cmd,Pos('|',cmd)+1,Length(cmd));
      if not dlgSave.Execute then
      begin
          IdTCPClient1.IOHandler.WriteLn('CANCEL');//告诉服务器取消
          IdTCPClient1.Disconnect;
          Exit;
      end;
      //分离文件大小
      TotalSize:=StrToInt(Copy(cmd,0,Pos('|',cmd)-1));
      //建立文件流准备接收
      AFileStream:=TFileStream.Create(dlgSave.FileName,fmCreate);
      try //开始循环接受
          Repeat
              IdTCPClient1.IOHandler.Writeln(IntToStr(AFileStream.Size));//发送当前传输的位置
              ASize:=Min(TotalSize-AFileStream.Size,IdTCPClient1.IOHandler.RecvBufferSize);
              //选择剩余大小和缓冲区大小小的一个作为传输的大小
              IdTCPClient1.IOHandler.ReadStream(AFileStream,ASize);//接收流
              StatusBar1.Panels[1].Text:=Format('当前传输位置%d/大小%d',[AFileStream.Size,TotalSize]);
              Application.ProcessMessages;
          Until AFileStream.Size=TotalSize;  //当大小一致时退出循环
      finally
          AFileStream.Free;//释放文件流
      end;
      IdTCPClient1.IOHandler.WriteLn('END');//告诉服务器已经接收完毕
      StatusBar1.Panels[1].Text:='传输文件成功';
    except
          StatusBar1.Panels[1].Text:= '连接服务器失败或者对方已经中断传输!';
    End;
    IdTCPClient1.Disconnect;              //断开连接
 end;

服务端

unit PasServer;

interface

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

type
  TfrmServer = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    btnStart: TButton;
    btnExit: TButton;
    btnOpen: TButton;
    IdTCPServer1: TIdTCPServer;
    OpenDialog1: TOpenDialog;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    btnCancel: TButton;
    procedure btnOpenClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure FormCreate(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    { Private declarations }
    AFileStream:TFileStream;
    procedure ButtonBegin;
    procedure ButtonEnd;
  public
    { Public declarations }
  end;

var
  frmServer: TfrmServer;

implementation

{$R *.dfm}

procedure TfrmServer.ButtonBegin;
begin //VCL开始状态设置
    btnStart.Enabled:=False;
    btnExit.Enabled:=False;
    btnCancel.Enabled:=True;
    btnOpen.Enabled:=False;
end;
procedure TfrmServer.ButtonEnd;
begin //VCL结束状态设置
    btnStart.Enabled:=True;
    btnExit.Enabled:=True;
    btnCancel.Enabled:=False;
    btnOpen.Enabled:=True;
end;
procedure TfrmServer.btnStartClick(Sender: TObject);
begin
    if not FileExists(Edit1.Text) then  //检测文件是否存在
    begin
        ShowMessage('文件不存在,请重新选择!!!');
        exit;
    end;
    //建立文件流
    AFileStream:=TFileStream.Create(Edit1.Text,fmOpenRead);
    ProgressBar1.Max:=AFileStream.Size;
    ProgressBar1.Position:=0;
    ButtonBegin;//VCL开始状态设置
    //服务器准备好连接
    IdTCPServer1.DefaultPort:=StrToIntDef(Edit2.Text,9225);
    if not IdTCPServer1.Active then IdTCPServer1.Active:=True;
end;

procedure TfrmServer.btnCancelClick(Sender: TObject);
begin
    StatusBar1.Panels[1].Text:='传输取消.....';
    AFileStream.Free;  //释放文件流
    ButtonEnd;   //VCL结束状态设置
end;

procedure TfrmServer.btnExitClick(Sender: TObject);
begin
    if IdTCPServer1.Active then
        IdTCPServer1.Active:=False;
    Close;
end;

procedure TfrmServer.btnOpenClick(Sender: TObject);
begin
    OpenDialog1.Execute;
    if OpenDialog1.FileName<>'' then
    begin
        Edit1.Text:=OpenDialog1.FileName;
        btnStart.Enabled:=True;
    end;
end;

procedure TfrmServer.FormCreate(Sender: TObject);
begin
    StatusBar1.Panels[1].Text:='文件传输服务器V1.1';
    btnStart.Enabled:=False;
    btnCancel.Enabled:=False;
end;

procedure TfrmServer.IdTCPServer1Connect(AContext: TIdContext);
begin
      Edit3.Text:=AContext.Binding.IP;
end;

procedure TfrmServer.IdTCPServer1Execute(AContext: TIdContext);
var
    cmd:string;       //客户端命令信息
    ASize:Integer;    //需要的传输流大小
begin
    with AContext.Connection do  //已经连街上的一个进程
    begin
        cmd:=UpperCase(IoHandler.ReadLn); //客户端发送的命令字符串
        if cmd='BEGIN' then //开始传输....
        begin
            //告诉客户机文件大小及文件名
            IoHandler.WriteLn(Format('%d|%s',[AFileStream.Size,ExtractFileName(Edit1.Text)]));
            StatusBar1.Panels[1].Text:='准备传输......';
            exit;
        end;
        if cmd='CANCEL' then //中止传输
        begin
            StatusBar1.Panels[1].Text:='客户中止传输....';
            //保持传输状态
            Exit;
        end;
        if cmd='END' then
        begin
            //文件传输完毕
            btnCancel.Click;
            StatusBar1.Panels[1].Text:='文件传输已经完成...';
            Exit;
        end;
        //按照指定位置传输文件
        AFileStream.Seek(StrToInt(cmd),soFromBeginning);//转到文件的传输位置
        ASize:=Min(AFileStream.Size-AFileStream.Position,IoHandler.RecvBufferSize);
        //计算需要发送大小,Min()函数在Math单元
        //IoHandler.WriteBufferOpen;//准备发送缓冲
        IoHandler.Write(AFileStream,Asize);
        //IoHandler.WriteBufferClose;
        StatusBar1.Panels[1].Text:=Format('当前文件传输位置%s/大小%d',[cmd,AFileStream.Size]);
        ProgressBar1.Position:=ProgressBar1.Position+ASize;
    end;
end;

end.

© 著作权归作者所有

vga

vga

粉丝 23
博文 371
码字总数 26854
作品 0
佳木斯
私信 提问
使用delphi 开发多层应用(四)kbmMW 的安装与配置

更新至kbmmw 5.04. (2017.12.14) --------------------- 目前的KbmMW 最新版是4.0 beta 版,它支持最新的delphi XE2 ,同时支持win32,win64,mac osx的编译开发。 增加了原生的JSON 的支持(看来...

xalion
2012/01/29
0
0
KbmMW 服务器架构简介

kbmmw 由于文档比较少,很多同学开始用时很难理解。一直准备写一个关于kbmmw 架构的东西。 这几天与红鱼儿(blog) 研究服务器线程时,整理了一下,大概画了一下kbmmw (版本4.5)服务器的架...

xalion
2014/06/22
0
0
从零开始开发JVM语言(十)指令与InvokeDynamic

目录戳这里 上一篇完成了语义分析的第三步。这一篇将开始语义分析的第四步也是最后一步,指令的解析。 这一步目标是将Statement转化为指令。 JVM针对同一事件的指令常常分为5种: 分别是 整型...

wkgcass
2016/06/17
109
0
实现KbmMw web server 支持https

在以前的文章里面介绍过kbmmw 做web server. 前几天红鱼儿非要我给他做一个支持https 的web server. 其实kbmmw 支持https 有好几种方法: 1. 使用isapi 部署到iis 或者是apache 上,使用iis...

xalion
2014/07/18
0
0
Hyperledger区块链技术生态

Hyperledger区块链技术生态 Hyperledger是一个专注于企业级区块链技术并推动区块链跨行业应用的开源项目,孵化并推广一系列区块链技术,包括分布式账本框架,智能合约引擎,客户端库,图形界...

Jonluo
05/29
33
0

没有更多内容

加载失败,请刷新页面

加载更多

Handler简解

Handler 这里简化一下代码 以便理解 Handler不一定要在主线程建 但如Handler handler = new Handler(); 会使用当前的Looper的, 由于要更新UI 所以最好在主线程 new Handler() { mLooper = Lo...

shzwork
17分钟前
2
0
h5获取摄像头拍照功能

完整代码展示: <!DOCTYPE html> <head> <title>HTML5 GetUserMedia Demo</title> <meta charset="utf-8"> <meta name="viewport" content="width=device-width, initial-scale=1.0, maximum......

诗书易经
19分钟前
1
0
正向代理和反向代理

文章来源 运维公会:正向代理和反向代理 1、正向代理 (1)服务对象不同 正向代理服务器的服务对象是客户端,可以将客户端和代理服务器看作一个整体。 (2)配置方法不同 需要在客户端配置代...

运维团
36分钟前
2
0
5个避免意外论文重复率高的方法

即使你不是故意抄袭,但你可能在无意中抄袭了别人的论文, 这个叫做意外抄袭,它可能正发生在你身上,如果你不熟悉学术 道德规范,这里将告诉你5个基本的方法来避免意外抄袭。 Tip1 熟悉其他...

论文辅导员
37分钟前
2
0
Maven通过profiles标签读取不同的配置

<profiles> <profile> <id>dev</id> <properties> <profiles.active>dev</profiles.active> </properties> ......

时刻在奔跑
42分钟前
1
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部