unit1.pas

多线程 网络传输 开发环境：Delphi7.0+WinXP

//************************************************//
//*           多线程网络传输客户端               *//
//*              作者：Feiler                    *//
//*            Delphibbs ID:masm                 *//
//*               QQ:16540127                    *//
//*            Email:[e-mail]               *//
//*你可以修改下面的代码，但请保留以上原信息      *//
//************************************************//

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient,Unit2;
const
packsize=65000;//包大小
type
TRevBuffer=packed record
 masmID:Word;//未用
  ID:Word;//标记
  F1:DWord;
  F2:DWord;
  F3:DWord;
  F4:DWord;
  Len:DWord;
  MD:Int64;
end;
TSendBuffer=packed record
  masmID:Word;//未用
  ID:Word;//标记
  F1:DWord;
  F2:DWord;
  F3:DWord;
  F4:DWord;
  Len:DWord;//数据区的大小
  MD:Int64;//摘要
  buffer:Array[0..packsize-1] of byte;
end;
//性能监测线程
type
  TMonitorThread = class(TThread)
  private
  SecondTimer:DWord;
  protected
    procedure Execute; override;
  public
  constructor Create(); reintroduce;

  end;



type
  TFeiler = class;
  TSocketThread = class(TThread)
  private
    Rev:TRevBuffer;
    Snd:TSendBuffer;
    PRev,PSnd,TP,UP:PByte;
    TempPointer:PByte;
    RemainBytes:Word;
    ReceivedCounter:Integer;
    HeaderFinished,BodyFinished,PushTransporting:Boolean;

    FeilerThread : TFeiler;
    MyIndex:Integer;
    FClient:TIdTCPClient;
    SendBytes:DWord;//该线程要传输的字节数
    MapOffset:DWord;//文件映像指针偏移
    FileMapPointer:PByte;//内存映像文件指针
    SendBlock:DWord;//该线程要传输的块数
    Thread_H,Thread_T:DWord;
    procedure Process;
    procedure Branch;
    procedure RequestTransfer;
    procedure ServerReady;
    procedure transporting;
  protected
    procedure Execute; override;
  public
    constructor Create(F: TFeiler;Index:Integer;Offset:DWord;Count:DWord;FileMap:PByte); reintroduce;
  end;
  TFeiler = class(TForm)
    Edit1: TEdit;
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    Edit2: TEdit;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button3: TButton;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    FileSize:DWord;//要传输的文件大小
    SocketThread:Array of TSocketThread;
    Event:Array of THandle;
    Instructor:Array of TProgressBar;
    MonitorThread:TMonitorThread;
    MP:PByte;
    { Public declarations }
  end;

var
  Feiler: TFeiler;
  ShowProgress:Boolean;
  HeightInc:Integer;



implementation

{$R *.dfm}
constructor TSocketThread.Create(F: TFeiler;Index:Integer;Offset:DWord;Count:DWord;FileMap:PByte);
var
Iswork:Boolean;
begin
  FeilerThread := F;
  MyIndex:=Index;
  MapOffset:=Offset;
  SendBytes:=Count;
  FileMapPointer:=FileMap;
  INC(FileMapPointer,Offset);
  SentBytes[MyIndex]:=0;
  IF Index=0 then
  Iswork:=False
    else
    Iswork:=True;
  ReceivedCounter:=32;
  PRev:=@Rev;PSnd:=@Snd;TempPointer:=PRev;
  inherited Create(IsWork);
end;

procedure TSocketThread.Execute;
var
H,I,J:Integer;
Thread_L:Integer;
CurPointerOffset:DWord;
File_Name:String[250];
begin
  FClient:=TIdTCPClient.Create(nil);
  FClient.Host:=FeilerThread.Edit1.Text;
  FClient.Port:=60606;
  try
  FClient.Connect(10000);
  except
  //错误处理
  Application.MessageBox('无法连接服务器','ERROR',MB_ICONERROR);
  FClient.Free;
  exit;
  end;
  //**接收服务器信息**//
  Thread_H:=(SendBytes-1) div packsize +1;//需要传输Thread_H个数据块
  Thread_T:=SendBytes-(Thread_H-1)*packsize;//尾巴
  FeilerThread.Instructor[MyIndex].Max:=Thread_H;
  Snd.F2:=Thread_H;
  IF MyIndex=0 then//0号线程负责初始化服务器
  begin
  Snd.ID:=0;//通知服务器建立文件
  TP:=PSnd;Inc(TP,32);
  File_name:=ExtractFileName(FeilerThread.Edit2.Text);
  Snd.Len:=Length(File_name)+1;
  Snd.F1:=FeilerThread.FileSize;
  UP:=@File_name;
  move(UP^,TP^,Snd.Len);
  FClient.Socket.Send(PSnd^,Snd.Len+32);//通知服务器
  repeat
  process;
  until Rev.ID=3;//Snd.F1=Snd.F2;
  SentBytes[MyIndex]:=SentBytes[MyIndex]+Snd.Len;//最后一个尾巴
  H:=Length(FeilerThread.Event);

    IF H>1 then//2个线程以上的话
    WaitForMultipleObjects(H-1,@FeilerThread.Event[1],True,INFINITE);
    Feiler.MonitorThread.Terminate;
    Snd.ID:=3;//告知服务器关闭内存影像
    Snd.Len:=0;
    FClient.Socket.Send(PSnd^,32);
    UnMapViewOfFile(FeilerThread.MP);//关闭内存映像
    For I:=0 to H-1 do
    CloseHandle(FeilerThread.Event[I]);
    SetLength(FeilerThread.Event,0);
    FeilerThread.Button1.Enabled:=True;
  end
    else
        begin
        RequestTransfer;
        repeat
        process;
        until Rev.ID=3;//Snd.F1=Snd.F2;
        SentBytes[MyIndex]:=SentBytes[MyIndex]+Snd.Len;
        SetEvent(FeilerThread.Event[MyIndex]);
        end;
FClient.Disconnect;

end;

procedure TFeiler.Button2Click(Sender: TObject);
var
F:Tsearchrec;
begin
IF OpenDialog1.Execute then
Edit2.Text:=OpenDialog1.FileName;
IF FindFirst(Edit2.Text,FaAnyfile,F)=0 then
FileSize:=F.Size;
end;

procedure TFeiler.Button1Click(Sender: TObject);
var
H,I,J,K,U:Integer;
FH,MH:THandle;
begin
//建立文件内存映像
Button1.Enabled:=False;
FH:=FileOpen(Edit2.Text,fmOpenRead);
MH:=CreateFileMapping(FH,nil,Page_ReadOnly,0,FileSize,nil);
CloseHandle(FH);
MP:=MapViewOfFile(MH,File_Map_Read,0,0,FileSize);
CloseHandle(MH);
J:=strtoint(ComboBox1.Text);
I:=(FileSize-1) div (1024*1024) + 1;//最多线程数
IF  J>I then
J:=I;
//一共有J个线程
//建立进度指示
ThreadCount:=J;
For K:=0 to  Length(Instructor)-1 do
Instructor[K].Free;
SetLength(Instructor,J);
SetLength(SentBytes,J);
For K:=0 to J-1 do
begin
Instructor[K]:=TProgressBar.Create(self);
Instructor[K].Left:=0;
Instructor[K].Top:=K*16;
Instructor[K].Width:=390;
Instructor[K].Step:=1;
Instructor[K].Parent:=Panel1;
end;

I:=FileSize div J;//每个线程的传输字节
K:=FileSize-I*J;//最后一个线程要多传输的字节，尾巴
U:=I;
SetLength(SocketThread,J);
SetLength(Event,J);
For H:=0 to J-1 do
begin
IF H=J-1 then
I:=I+K;//最后的数据块
SocketThread[H]:=TSocketThread.Create(self,H,H*U,I,MP);
Event[H]:=CreateEvent(nil,False,False,nil);

end;//循环结束

end;

procedure TSocketThread.Branch;
begin
case Rev.ID of
1:ServerReady;
2:transporting;

end;
end;

procedure TSocketThread.RequestTransfer;
begin
Snd.ID:=1;
Snd.F1:=0;
Snd.Len:=0;
FClient.Socket.Send(PSnd^,32);
end;

procedure TSocketThread.Process;
var
Bytes:Integer;
begin
IF RemainBytes>0 then//上次还有字节没收取
    begin
    ReceivedCounter:=ReceivedCounter-RemainBytes;
    IF ReceivedCounter>0 then//接收剩余字节后数据报尚未完成接收
    begin
    Bytes:=RemainBytes;//接收剩余
    RemainBytes:=0;
    end
        else
        begin
            IF ReceivedCounter=0 then//剩余字节刚好接收完成
            begin
            Bytes:=RemainBytes;
            RemainBytes:=0;
            IF HeaderFinished then
            BodyFinished:=True
            else
                begin
                HeaderFinished:=True;//如果头完成就是体完成，否则只是头完成
                PushTransporting:=True;
                end;
            end
                else
                begin   //剩余字节超过本数据报大小，产生数据粘连
                Bytes:=ReceivedCounter+RemainBytes;
                RemainBytes:=RemainBytes-Bytes;//完成本数据报后剩余字节
                IF HeaderFinished then
                BodyFinished:=True
                    else
                        begin
                        HeaderFinished:=True;//如果头完成就是体完成，否则只是头完成
                        PushTransporting:=True;
                        end;
                end;
        end;
     FClient.ReadBuffer(TempPointer^,Bytes);
     Inc(TempPointer,Bytes);
     IF (Rev.Len=0) and HeaderFinished then//只要头
     begin
     HeaderFinished:=False;
     PushTransporting:=False;
     TempPointer:=PRev;
     ReceivedCounter:=32;//准备下一个头
     Branch;//分支处理
     end
        else
        begin
            IF PushTransporting then //正在传输body
            begin
            PushTransporting:=False;
            ReceivedCounter:=Rev.Len;
            end
            else
                IF BodyFinished then
                begin
                TempPointer:=PRev;
                HeaderFinished:=False;
                BodyFinished:=False;
                ReceivedCounter:=32;//准备下一个头
                Branch;//分支处理
                end

        end;

     end
     else
        begin//RemainBytes=0
        Try
        RemainBytes:=FClient.ReadFromStack(True,15000,True);
        Except
        exit;
        end;

        end;



end;


procedure TSocketThread.ServerReady;
var
H:Integer;
begin
For H:=2 to strtoint(Feiler.ComboBox1.Text) do
Feiler.SocketThread[H-1].Resume;
RequestTransfer;
Feiler.MonitorThread:=TMonitorThread.Create;
end;

procedure TSocketThread.transporting;
var
FTT,FUU:PByte;
begin
SentBytes[MyIndex]:=SentBytes[MyIndex]+Snd.Len;//已发送字节
Snd.ID:=2;
Snd.F1:=Rev.F1;
IF Snd.F1=Snd.F2 then
Snd.Len:=Thread_T
else
Snd.Len:=packsize;
Snd.F3:=MapOffset+(Snd.F1-1)*packsize;
FTT:=FileMapPointer;
INC(FTT,(Snd.F1-1)*packsize);
FUU:=PSnd;Inc(FUU,32);
move(FTT^,FUU^,Snd.Len);
FClient.Socket.Send(PSnd^,Snd.Len+32);
FeilerThread.Instructor[MyIndex].StepIt;
end;

procedure TFeiler.Button3Click(Sender: TObject);
begin
IF  Not(ShowProgress)    then
Button3.Caption:='<<进度显示'
else
    Button3.Caption:='进度显示>>';
ShowProgress:=Not(ShowProgress);
IF ShowProgress then
begin
HeightInc:=strtoint(ComboBox1.Text)*20;
Feiler.Height:=Feiler.Height+HeightInc;



end
else
    begin
    Feiler.Height:=Feiler.Height-HeightInc;

    end;





end;

{ TMonitorThread }



constructor TMonitorThread.Create;
begin
SecondTimer:=0;
inherited Create(false);
end;

procedure TMonitorThread.Execute;
var
H,I,V:DWord;
begin
While Not(Terminated) do
    begin
    Sleep(1000);
    SecondTimer:=SecondTimer+1;
    H:=0;
    For I:=0 to ThreadCount-1 do
    H:=H+SentBytes[I];
    V:=H div SecondTimer;
    V:=V div 1024;
    Feiler.StatusBar1.Panels[2].Text:='平均速率:'+Inttostr(V)+'KB/S';
    end;

end;

procedure TFeiler.FormClose(Sender: TObject; var Action: TCloseAction);
var
K:Integer;
begin
For K:=0 to  Length(Instructor)-1 do
Instructor[K].Free;
SetLength(Instructor,0);
SetLength(SentBytes,0);
SetLength(SocketThread,0);
SetLength(Event,0);
end;

end.