//服务端:

const
  //transmit用的参数
  TF_USE_KERNEL_APC     = $20;
  //命令类型
  CMD_CapScreen             = 2000;
  CMD_CapVideo              = 2001;
  CMD_CapAudio              = 2002;
  CMD_GetSystemInfo         = 2003;
  CMD_TransmitFiles         = 2004;
  
//通用数据传输包体封装
type
  //每个完整数据的头描述
  TPacketHeader =  packed record
     PacketCMD    : Word;   //包类型
     DataLength   : Word;   //包体长度
     IsCompressed : Boolean//包体是否为压缩数据
  end;
  TBytes = array [0..65535of Byte;
  TPacketBody = packed record
     Data : TBytes;
  end;
  //完整的数据包
  TPacketInfo = packed record
    Header : TPacketHeader;
    Body   : TPacketBody;
  end;
  //文件发送包
  TFileSendPacket = packed record
    FileName : array [0..127of Char;
    FileSize : LongWord;
    StartWritePositon : LongWord;
    hFile : THandle;
  end;
function TServerClientSocket.TransFile(FileName: string;StartWritePositon:LongWord): Boolean;
var
  hFile : THandle;
  NumberOfByteSend : LongWord;
  Block:PBlock;
  PacketInfo: TPacketInfo;
  FileSendPacket : TFileSendPacket;
  AFileName : string[128];
  TransmitFileBuffers : TTransmitFileBuffers;
begin
    if not FileExists(FileName) then
    begin
      Result := False;
      Exit;
    end;
    
    hFile := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 00);
    //如果文件打开错误,则退出
    if hFile = INVALID_HANDLE_VALUE then
    begin
      Result := False;
      Closehandle(hFile);
      Exit;
    end;
    //得到需要传输的字节数
    NumberOfByteSend := windows.GetFileSize(hFile, nil) - StartWritePositon;
    if NumberOfByteSend <= 0 then
    begin
      Closehandle(hFile);
      Exit;
    end;
    Block := AllocBlock;
    Block.Data.Event := seFileSend;
    Block.Data.Overlapped.Offset := StartWritePositon;
    AFileName := ExtractFileName(FileName);
    FillChar(PacketInfo,SizeOf(TPacketInfo),0);
    FillChar(FileSendPacket,SizeOf(TFileSendPacket),0);
    Move(AFileName[1],FileSendPacket.FileName,length(AFileName));
    FileSendPacket.FileSize := NumberOfByteSend;
    FileSendPacket.StartWritePositon := StartWritePositon;
    FileSendPacket.hFile := hFile;
    PacketInfo.Header.PacketCMD := CMD_TransmitFiles;
    PacketInfo.Header.DataLength := Sizeof(TFileSendPacket);
    PacketInfo.Header.IsCompressed := False;
    Move(FileSendPacket,PacketInfo.Body.Data,SizeOf(TFileSendPacket));
    Move(PacketInfo,Block^.Data.Buffer,SizeOf(TPacketHeader) + SizeOf(TFileSendPacket));
    //传输文件前发送的包
    TransmitFileBuffers.Head := @Block^.Data.Buffer[0];
    TransmitFileBuffers.HeadLength := SizeOf(TPacketHeader) + SizeOf(TFileSendPacket);
    //传输文件完毕后发送的包
    TransmitFileBuffers.Tail := nil;
    TransmitFileBuffers.TailLength := 0;
    LogMsg('开始发送文件:' + FileName + ' Size=' + IntToStr(NumberOfByteSend));
    //发送命令,并将文件名、继传点、需要传输的大小传递过去
    if not TransmitFile(SocketHandle, hFile, NumberOfByteSend, MAX_BUFSIZE,
      @Block^.Data.Overlapped, @TransmitFileBuffers, TF_USE_KERNEL_APC) then
    begin
      if GetLastError <> ERROR_IO_PENDING then
      begin
        Result := False;
        Exit;
      end;
    end;
    Result := True;
end;
//如果发送完毕,可以接收到重叠IO的返回结果
    case Block^.Data.Event of
      seFileSend:
      begin
        Block.IsUse := False;
        Move(Block.Data.Buffer,PacketInfo,SizeOf(TPacketHeader) + SizeOf(TFileSendPacket));
        if PacketInfo.Header.PacketCMD = CMD_TransmitFiles then
        begin
           FillChar(FileSendPacket,SizeOf(TFileSendPacket),0);
           Move(PacketInfo.body.data,FileSendPacket,SizeOf(TFileSendPacket));
           Closehandle(FileSendPacket.hFile); //发送完毕,关闭文件句柄
        end;
        LogMsg('文件:' + StrPas(FileSendPacket.FileName) + '  发送完毕!');
        if not PrepareRecv() then Result := RESPONSE_FAIL;       
      end;
      seRead: 。。。。。。。
  
//客户端:
procedure TrecvThread.Execute;
var PacketInfo : TPacketInfo;
    str: string;
    FileSendPacket:TFileSendPacket;
    FileStream:TFileStream;
    FileName :string;
    RecBuf:array[0..1023of Char;
    RemainByts,RecvedBytes:Integer;
begin
  while (not self.Terminated ) DO
  begin
    cs.CheckForDisconnect(False);
     if cs.ClosedGracefully then
     begin
        Fmm.Lines.Add('链路断开!');
        self.Terminate;
     end;
     cs.ReadBuffer(PacketInfo.Header,SizeOf(TPacketHeader));
     cs.ReadBuffer(PacketInfo.Body.Data, PacketInfo.Header.DataLength);
     if PacketInfo.Header.PacketCMD = CMD_TransmitFiles then
     begin
       Move(PacketInfo.Body.Data,FileSendPacket,PacketInfo.Header.DataLength);
       FileName := StrPas(FileSendPacket.FileName);
       try
         FileStream := TFileStream.Create('C:\'+ FileName, fmCreate or fmOpenWrite);
         Fmm.Lines.Add('接收:' + FileName + ' Size=' + IntToStr(FileSendPacket.FileSize));
         RecvedBytes := 0;
         while (RecvedBytes < FileSendPacket.FileSize) do
         begin
           if FileSendPacket.FileSize <= 1024 then
           begin
             cs.ReadBuffer(RecBuf,FileSendPacket.FileSize);
             RecvedBytes := FileSendPacket.FileSize;
             FileStream.WriteBuffer(RecBuf,RecvedBytes);
             Break;
           end else begin
             cs.ReadBuffer(RecBuf,1024);
             RecvedBytes := RecvedBytes + 1024;
             FileStream.WriteBuffer(RecBuf,1024);
             RemainByts := FileSendPacket.FileSize - RecvedBytes;
             if RemainByts <= 1024 then
             begin
               cs.ReadBuffer(RecBuf,RemainByts);
               RecvedBytes := RecvedBytes + RemainByts;
               FileStream.WriteBuffer(RecBuf,RemainByts);
               Break;
             end;
           end;
         end;
       finally
          FileStream.Free;
       end;
     end;
  end;
end;

http://www.delphi6.com/thread-554.htm

基于IOCP的高速文件传输代码的更多相关文章

  1. Tftp文件传输服务器(基于UDP协议)

    一个简单的UDP服务端与客户端 服务端: from socket import * #创建套接字 udp_server = socket(AF_INET,SOCK_DGRAM) msg_server ...

  2. WCF大文件传输服务

    由于项目需要,自己写一个基于WCF的大文件传输服务雏形.觉得有一定的参考价值,因此放在网上分享. 目前版本为v1.1特点如下: 1.文件传输端口为18650 2.上传和下载文件 3.支持获取文件传输状 ...

  3. vsftpd-基于ftp协议的文件传输服务器软件

    第一部分:在Linux上部署vsftpd服务 1. vsftpd简介 1.1 vsftpd是什么? ftp(File Transfer Protocol)文件传输协议.(实现不同操作系统之间文件的传输 ...

  4. QT从入门到入土(九)——TCP/IP网络通信(以及文件传输)

    引言 TCP/IP通信(即SOCKET通信)是通过网线将服务器Server端和客户机Client端进行连接,在遵循ISO/OSI模型的四层层级构架的基础上通过TCP/IP协议建立的通讯.控制器可以设置 ...

  5. Python之路(第三十二篇) 网络编程:udp套接字、简单文件传输

    一.UDP套接字 服务端 # udp是无链接的,先启动哪一端都不会报错 # udp没有链接,与tcp相比没有链接循环,只有通讯循环 server = socket.socket(socket.AF_I ...

  6. Python实现终端FTP文件传输

    实现终端FTP文件传输 代码结构: .├── client.py├── readme.txt└── server.py 运行截图: readme.txt tftp文件服务器 项目功能: * 客户端有简 ...

  7. Python自带HTTP文件传输服务

    一行命令搭建一个基于python的http文件传输服务 由于今天朋友想要一个文件,而我恰好有,因为这个文件比较大,网速不是很给力,所以想到了python自己有这么一个功能,这样不仅不需要下载其他软件, ...

  8. Java基于Socket文件传输示例(转)

    最近需要进行网络传输大文件,于是对基于socket的文件传输作了一个初步的了解.在一位网友提供的程序基础上,俺进行了一些加工,采用了缓冲输入/输出流来包装输出流,再采用数据输入/输出输出流进行包装,加 ...

  9. Java基于Socket文件传输示例

    http://www.blogjava.net/sterning/archive/2007/10/13/152508.html 最近需要进行网络传输大文件,于是对基于socket的文件传输作了一个初步 ...

随机推荐

  1. Django之富文本编辑器kindeditor 及上传

    1.什么是富文本编辑器 百度百科(https://baike.baidu.com/item/%E5%AF%8C%E6%96%87%E6%9C%AC%E7%BC%96%E8%BE%91%E5%99%A8 ...

  2. 定时清理tomcat日志文件

    原文链接:https://blog.csdn.net/qq_37936542/article/details/78788466 需求:最近公司服务器发现磁盘经常会被占满,查其原因是因为大量的日志文件. ...

  3. 手把手教你完成App支付JAVA后台-支付宝支付JAVA

    接着上一篇博客,我们暂时完成了手机端的部分支付代码,接下来,我们继续写后台的代码. 后台基本需要到以下几个参数,我都将他们写在了properties文件中: 支付宝参数 AliPay.payURL = ...

  4. VS关于 _CRT_SECURE_NO_WARNINGS 警告说明

    在VS中调用 strcpy.strcat 等函数时会提示 _CRT_SECURE_NO_WARNINGS 警告.原因是这些函数不安全.可能会造成内存泄露等. 所以建议採用带_s的函数,如strcpy_ ...

  5. [Angular] Reactive Form -- FormControl & formControlName, FormGroup, formGroup & formGroupName

    First time dealing with Reactive form might be a little bit hard to understand. I have used Angular- ...

  6. 具体分析contrex-A9的汇编代码__switch_to(进程切换)

    //函数原型:版本号linux-3.0.8 struct task_struct *__switch_to(structtask_struct *, struct thread_info *, str ...

  7. 学习鸟哥的Linux私房菜笔记(7)——文件查找与文件管理1

    一.可执行文件的搜索 which 显示一个可执行文件的完整路径 按照alias->$PATH的顺序查找 查看系统的环境变量 whereis 搜索一个可执行工具及其相关配置.帮助 slocate ...

  8. WPF入门(三)->几何图形之不规则图形(PathGeometry)

    原文:WPF入门(三)->几何图形之不规则图形(PathGeometry) 前面我们给大家介绍了LineGeometry,EllipseGeometry,CombinedGeometry等一些规 ...

  9. Linux硬件信息查询命令

    系统 uname -a              # 查看内核/操作系统/CPU信息 Linux hostname 2.6.18-128.el5 #1 SMP Wed Dec 17 11:41:38 ...

  10. spring定时任务.线程池,自定义多线程配置

    定时任务及多线程配置xml <?xml version="1.0" encoding="UTF-8"?> <beans xmlns=" ...