//服务端:

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. web报表工具FineReport经常使用函数的使用方法总结(文本函数)

    文本函数 CHAR CHAR(number):依据指定数字返回相应的字符.CHAR函数可将计算机其它类型的数字代码转换为字符. Number:用于指定字符的数字,介于1Number:用于指定字符的数字 ...

  2. windows下的定时任务设置详解

    windows下的定时任务设置详解 一.总结 一句话总结: 1.php.exe是什么? 就是php中自带的一个exe,不是我们写的,这个exe是可以执行其他的PHP的 二.windows下的定时任务设 ...

  3. 【u021】广义斐波那契数列

    Time Limit: 1 second Memory Limit: 128 MB [问题描述] 广义的斐波那契数列是指形如an=p*an-1+q*an-2的数列.今给定数列的两系数p和q,以及数列的 ...

  4. 简单实现的Servlet文件上传,并显示

    http://my.oschina.net/Barudisshu/blog/157481

  5. TimeUnit用法

    TimeUnit是java.util.concurrent包下面的一个类,表示给定单元粒度的时间段 1.主要作用 时间颗粒度转换 延时 2.常用的颗粒度 TimeUnit.DAYS //天 TimeU ...

  6. 浅谈 Redis 与 MySQL 的耦合性以及利用管道完成 MySQL 到 Redis 的高效迁移

    http://blog.csdn.net/dba_waterbin/article/details/8996872 ㈠ Redis 与 MySQL 的耦合性            在业务架构早期.我们 ...

  7. spark 2.0.2 集群搭建

    由于之前已经搭建过hadoop相关环境,现在搭建spark的预备工作只有scala环境了 一,配置scala环境 1.解压tar包后,编辑/etc/profile 2.source /etc/prof ...

  8. POJ 2728 - 最小比例生成树

    传送门 题目大意 有n个村庄,每个村庄都有一个(x, y)坐标和z海拔,定义两个村庄间的dist为坐标的距离,cost为海拔差的绝对值,求图的一颗生成树,使得\(\frac{\sum cost}{\s ...

  9. windows 下使用 virtualenv 创建虚拟环境

    virtualenv虚拟环境为每个项目隔离了一套运行类库,不同的项目在各自的虚拟环境中使用不同的类库,避免了将所有类库都安装到系统环境中导致的不同项目需要不同(版本)类库的问题,项目与项目之间的类库依 ...

  10. 【心情】2016ICPC青岛站打铁记

    Day0 下午到的青岛; 然后就在下面这两个地方转了很久:一直找不到公交站台 路上还看到了一个类似堡垒的东西:感觉屌屌的. 然后在落日的余晖下:我们找到了公交站台; 路上不知道他们在讨论什么:GPS什 ...