1、多线程网络传输客户端unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,Unit2;constpacksize=65000;/包大小typeTRevBuffer=packed record masmID:Word;/未用 ID:Word;/标记 F1:DW
2、ord; 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:Array0.packsize-1 of byte;end;/性能监测线程type TMonitorThread = class(TThread) private SecondTimer:DWord; protecte
3、d 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
4、: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; pro
5、cedure 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: TOpenDia
6、log; 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); pr
7、ivate 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 *.df
8、mconstructor TSocketThread.Create(F: TFeiler;Index:Integer;Offset:DWord;Count:DWord;FileMap:PByte);varIswork:Boolean;begin FeilerThread := F; MyIndex:=Index; MapOffset:=Offset; SendBytes:=Count; FileMapPointer:=FileMap; INC(FileMapPointer,Offset); SentBytesMyIndex:=0; IF Index=0 then Iswork:=False e
9、lse Iswork:=True; ReceivedCounter:=32; PRev:=Rev;PSnd:=Snd;TempPointer:=PRev; inherited Create(IsWork);end;procedure TSocketThread.Execute;varH,I,J:Integer;Thread_L:Integer;CurPointerOffset:DWord;File_Name:String250;begin FClient:=TIdTCPClient.Create(nil); FClient.Host:=FeilerThread.Edit1.Text; FCli
10、ent.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.InstructorMyIndex.Max:=Thread_H; Snd
11、.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 proce
12、ss; until Rev.ID=3;/Snd.F1=Snd.F2; SentBytesMyIndex:=SentBytesMyIndex+Snd.Len;/最后一个尾巴 H:=Length(FeilerThread.Event); IF H1 then/2个线程以上的话 WaitForMultipleObjects(H-1,FeilerThread.Event1,True,INFINITE); Feiler.MonitorThread.Terminate; Snd.ID:=3;/告知服务器关闭内存影像 Snd.Len:=0; FClient.Socket.Send(PSnd,32); UnM
13、apViewOfFile(FeilerThread.MP);/关闭内存映像 For I:=0 to H-1 do CloseHandle(FeilerThread.EventI); SetLength(FeilerThread.Event,0); FeilerThread.Button1.Enabled:=True; end else begin RequestTransfer; repeat process; until Rev.ID=3;/Snd.F1=Snd.F2; SentBytesMyIndex:=SentBytesMyIndex+Snd.Len; SetEvent(FeilerTh
14、read.EventMyIndex); end;FClient.Disconnect;end;procedure TFeiler.Button2Click(Sender: TObject);varF:Tsearchrec;beginIF OpenDialog1.Execute thenEdit2.Text:=OpenDialog1.FileName;IF FindFirst(Edit2.Text,FaAnyfile,F)=0 thenFileSize:=F.Size;end;procedure TFeiler.Button1Click(Sender: TObject);varH,I,J,K,U
15、: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;
16、/最多线程数IF JI thenJ:=I;/一共有J个线程/建立进度指示ThreadCount:=J;For K:=0 to Length(Instructor)-1 doInstructorK.Free;SetLength(Instructor,J);SetLength(SentBytes,J);For K:=0 to J-1 dobeginInstructorK:=TProgressBar.Create(self);InstructorK.Left:=0;InstructorK.Top:=K*16;InstructorK.Width:=390;InstructorK.Step:=1;Ins
17、tructorK.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 dobeginIF H=J-1 thenI:=I+K;/最后的数据块SocketThreadH:=TSocketThread.Create(self,H,H*U,I,MP);EventH:=CreateEvent(nil,False,False,nil);end;/循环结束end;proc
18、edure TSocketThread.Branch;begincase Rev.ID of1:ServerReady;2:transporting;end;end;procedure TSocketThread.RequestTransfer;beginSnd.ID:=1;Snd.F1:=0;Snd.Len:=0;FClient.Socket.Send(PSnd,32);end;procedure TSocketThread.Process;varBytes:Integer;beginIF RemainBytes0 then/上次还有字节没收取 begin ReceivedCounter:=
19、ReceivedCounter-RemainBytes; IF ReceivedCounter0 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;/如果头完成就是体完成,否则
20、只是头完成 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.ReadBuff
21、er(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
22、:=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.Serv
23、erReady;varH:Integer;beginFor H:=2 to strtoint(Feiler.ComboBox1.Text) doFeiler.SocketThreadH-1.Resume;RequestTransfer;Feiler.MonitorThread:=TMonitorThread.Create;end;procedure TSocketThread.transporting;varFTT,FUU:PByte;beginSentBytesMyIndex:=SentBytesMyIndex+Snd.Len;/已发送字节Snd.ID:=2;Snd.F1:=Rev.F1;I
24、F Snd.F1=Snd.F2 thenSnd.Len:=Thread_TelseSnd.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.InstructorMyIndex.StepIt;end;procedure TFeiler.Button3Click(
25、Sender: TObject);beginIF Not(ShowProgress) thenButton3.Caption:=;ShowProgress:=Not(ShowProgress);IF ShowProgress thenbeginHeightInc:=strtoint(ComboBox1.Text)*20;Feiler.Height:=Feiler.Height+HeightInc;endelse begin Feiler.Height:=Feiler.Height-HeightInc; end;end; TMonitorThread constructor TMonitorTh
26、read.Create;beginSecondTimer:=0;inherited Create(false);end;procedure TMonitorThread.Execute;varH,I,V:DWord;beginWhile Not(Terminated) do begin Sleep(1000); SecondTimer:=SecondTimer+1; H:=0; For I:=0 to ThreadCount-1 do H:=H+SentBytesI; V:=H div SecondTimer; V:=V div 1024; Feiler.StatusBar1.Panels2.
27、Text:=平均速率:+Inttostr(V)+KB/S; end;end;procedure TFeiler.FormClose(Sender: TObject; var Action: TCloseAction);varK:Integer;beginFor K:=0 to Length(Instructor)-1 doInstructorK.Free;SetLength(Instructor,0);SetLength(SentBytes,0);SetLength(SocketThread,0);SetLength(Event,0);end;end.unit Unit1;interfaceu
28、ses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,SocketProcess, IdBaseComponent, IdComponent, IdTCPServer;type TForm1 = class(TForm) Button1: TButton; IdTCPServer1: TIdTCPServer; Memo1: TMemo; Button2: TButton; procedure IdTCPServer1Connect(AThread: TI
29、dPeerThread); procedure IdTCPServer1Disconnect(AThread: TIdPeerThread); procedure IdTCPServer1Execute(AThread: TIdPeerThread); procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button2Click(Sender: TObject); private Private declarations public Public declarations end;var Form1: TForm1; Lock_exe: TRTLCriticalSection;implementation$R *.dfmprocedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);varDoP:TSocketProcesser;beginDoP:=TSocketProcesser.Create(AThrea
copyright@ 2008-2022 冰豆网网站版权所有
经营许可证编号:鄂ICP备2022015515号-1