多线程网络传输客户端.docx
《多线程网络传输客户端.docx》由会员分享，可在线阅读，更多相关《多线程网络传输客户端.docx（16页珍藏版）》请在冰豆网上搜索。
多线程网络传输客户端
unitUnit1;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,ComCtrls,ExtCtrls,StdCtrls,IdBaseComponent,IdComponent,
IdTCPConnection,IdTCPClient,Unit2;
const
packsize=65000;//包大小
type
TRevBuffer=packedrecord
masmID:
Word;//未用
ID:
Word;//标记
F1:
DWord;
F2:
DWord;
F3:
DWord;
F4:
DWord;
Len:
DWord;
MD:
Int64;
end;
TSendBuffer=packedrecord
masmID:
Word;//未用
ID:
Word;//标记
F1:
DWord;
F2:
DWord;
F3:
DWord;
F4:
DWord;
Len:
DWord;//数据区的大小
MD:
Int64;//摘要
buffer:
Array[0..packsize-1]ofbyte;
end;
//性能监测线程
type
TMonitorThread=class（TThread）
private
SecondTimer:
DWord;
protected
procedureExecute;override;
public
constructorCreate（）;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;
procedureProcess;
procedureBranch;
procedureRequestTransfer;
procedureServerReady;
proceduretransporting;
protected
procedureExecute;override;
public
constructorCreate（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;
procedureButton2Click（Sender:
TObject）;
procedureButton1Click（Sender:
TObject）;
procedureButton3Click（Sender:
TObject）;
procedureFormClose（Sender:
TObject;varAction:
TCloseAction）;
private
{Privatedeclarations}
public
FileSize:
DWord;//要传输的文件大小
SocketThread:
ArrayofTSocketThread;
Event:
ArrayofTHandle;
Instructor:
ArrayofTProgressBar;
MonitorThread:
TMonitorThread;
MP:
PByte;
{Publicdeclarations}
end;
var
Feiler:
TFeiler;
ShowProgress:
Boolean;
HeightInc:
Integer;
implementation
{$R*.dfm}
constructorTSocketThread.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;
IFIndex=0then
Iswork:
=False
else
Iswork:
=True;
ReceivedCounter:
=32;
PRev:
=@Rev;PSnd:
=@Snd;TempPointer:
=PRev;
inheritedCreate（IsWork）;
end;
procedureTSocketThread.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）divpacksize+1;//需要传输Thread_H个数据块
Thread_T:
=SendBytes-（Thread_H-1）*packsize;//尾巴
FeilerThread.Instructor[MyIndex].Max:
=Thread_H;
Snd.F2:
=Thread_H;
IFMyIndex=0then//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;
untilRev.ID=3;//Snd.F1=Snd.F2;
SentBytes[MyIndex]:
=SentBytes[MyIndex]+Snd.Len;//最后一个尾巴
H:
=Length（FeilerThread.Event）;
IFH>1then//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）;//关闭内存映像
ForI:
=0toH-1do
CloseHandle（FeilerThread.Event[I]）;
SetLength（FeilerThread.Event,0）;
FeilerThread.Button1.Enabled:
=True;
end
else
begin
RequestTransfer;
repeat
process;
untilRev.ID=3;//Snd.F1=Snd.F2;
SentBytes[MyIndex]:
=SentBytes[MyIndex]+Snd.Len;
SetEvent（FeilerThread.Event[MyIndex]）;
end;
FClient.Disconnect;
end;
procedureTFeiler.Button2Click（Sender:
TObject）;
var
F:
Tsearchrec;
begin
IFOpenDialog1.Executethen
Edit2.Text:
=OpenDialog1.FileName;
IFFindFirst（Edit2.Text,FaAnyfile,F）=0then
FileSize:
=F.Size;
end;
procedureTFeiler.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;//最多线程数
IFJ>Ithen
J:
=I;
//一共有J个线程
//建立进度指示
ThreadCount:
=J;
ForK:
=0toLength（Instructor）-1do
Instructor[K].Free;
SetLength（Instructor,J）;
SetLength（SentBytes,J）;
ForK:
=0toJ-1do
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:
=FileSizedivJ;//每个线程的传输字节
K:
=FileSize-I*J;//最后一个线程要多传输的字节，尾巴
U:
=I;
SetLength（SocketThread,J）;
SetLength（Event,J）;
ForH:
=0toJ-1do
begin
IFH=J-1then
I:
=I+K;//最后的数据块
SocketThread[H]:
=TSocketThread.Create（self,H,H*U,I,MP）;
Event[H]:
=CreateEvent（nil,False,False,nil）;
end;//循环结束
end;
procedureTSocketThread.Branch;
begin
caseRev.IDof
1:
ServerReady;
2:
transporting;
end;
end;
procedureTSocketThread.RequestTransfer;
begin
Snd.ID:
=1;
Snd.F1:
=0;
Snd.Len:
=0;
FClient.Socket.Send（PSnd^,32）;
end;
procedureTSocketThread.Process;
var
Bytes:
Integer;
begin
IFRemainBytes>0then//上次还有字节没收取
begin
ReceivedCounter:
=ReceivedCounter-RemainBytes;
IFReceivedCounter>0then//接收剩余字节后数据报尚未完成接收
begin
Bytes:
=RemainBytes;//接收剩余
RemainBytes:
=0;
end
else
begin
IFReceivedCounter=0then//剩余字节刚好接收完成
begin
Bytes:
=RemainBytes;
RemainBytes:
=0;
IFHeaderFinishedthen
BodyFinished:
=True
else
begin
HeaderFinished:
=True;//如果头完成就是体完成，否则只是头完成
PushTransporting:
=True;
end;
end
else
begin//剩余字节超过本数据报大小，产生数据粘连
Bytes:
=ReceivedCounter+RemainBytes;
RemainBytes:
=RemainBytes-Bytes;//完成本数据报后剩余字节
IFHeaderFinishedthen
BodyFinished:
=True
else
begin
HeaderFinished:
=True;//如果头完成就是体完成，否则只是头完成
PushTransporting:
=True;
end;
end;
end;
FClient.ReadBuffer（TempPointer^,Bytes）;
Inc（TempPointer,Bytes）;
IF（Rev.Len=0）andHeaderFinishedthen//只要头
begin
HeaderFinished:
=False;
PushTransporting:
=False;
TempPointer:
=PRev;
ReceivedCounter:
=32;//准备下一个头
Branch;//分支处理
end
else
begin
IFPushTransportingthen//正在传输body
begin
PushTransporting:
=False;
ReceivedCounter:
=Rev.Len;
end
else
IFBodyFinishedthen
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;
procedureTSocketThread.ServerReady;
var
H:
Integer;
begin
ForH:
=2tostrtoint（Feiler.ComboBox1.Text）do
Feiler.SocketThread[H-1].Resume;
RequestTransfer;
Feiler.MonitorThread:
=TMonitorThread.Create;
end;
procedureTSocketThread.transporting;
var
FTT,FUU:
PByte;
begin
SentBytes[MyIndex]:
=SentBytes[MyIndex]+Snd.Len;//已发送字节
Snd.ID:
=2;
Snd.F1:
=Rev.F1;
IFSnd.F1=Snd.F2then
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;
procedureTFeiler.Button3Click（Sender:
TObject）;
begin
IFNot（ShowProgress）then
Button3.Caption:
='<<进度显示'
else
Button3.Caption:
='进度显示>>';
ShowProgress:
=Not（ShowProgress）;
IFShowProgressthen
begin
HeightInc:
=strtoint（ComboBox1.Text）*20;
Feiler.Height:
=Feiler.Height+HeightInc;
end
else
begin
Feiler.Height:
=Feiler.Height-HeightInc;
end;
end;
{TMonitorThread}
constructorTMonitorThread.Create;
begin
SecondTimer:
=0;
inheritedCreate（false）;
end;
procedureTMonitorThread.Execute;
var
H,I,V:
DWord;
begin
WhileNot（Terminated）do
begin
Sleep（1000）;
SecondTimer:
=SecondTimer+1;
H:
=0;
ForI:
=0toThreadCount-1do
H:
=H+SentBytes[I];
V:
=HdivSecondTimer;
V:
=Vdiv1024;
Feiler.StatusBar1.Panels[2].Text:
='平均速率:
'+Inttostr（V）+'KB/S';
end;
end;
procedureTFeiler.FormClose（Sender:
TObject;varAction:
TCloseAction）;
var
K:
Integer;
begin
ForK:
=0toLength（Instructor）-1do
Instructor[K].Free;
SetLength（Instructor,0）;
SetLength（SentBytes,0）;
SetLength（SocketThread,0）;
SetLength（Event,0）;
end;
end.
unitUnit1;
interface
uses
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;
procedureIdTCPServer1Connect（AThread:
TIdPeerThread）;
procedureIdTCPServer1Disconnect（AThread:
TIdPeerThread）;
procedureIdTCPServer1Execute（AThread:
TIdPeerThread）;
procedureButton1Click（Sender:
TObject）;
procedureFormClose（Sender:
TObject;varAction:
TCloseAction）;
procedureButton2Click（Sender:
TObject）;
private
{Privatedeclarations}
public
{Publicdeclarations}
end;
var
Form1:
TForm1;
Lock_exe:
TRTLCriticalSection;
implementation
{$R*.dfm}
procedureTForm1.IdTCPServer1Connect（AThread:
TIdPeerThread）;
var
DoP:
TSocketProcesser;
begin
DoP:
=TSocketProcesser.Create（AThrea
升级会员 