急求帮助：怎么让服务器支持多线程文件传输。 ( 积分: 100 )

  • 主题发起人 主题发起人 waterlili
  • 开始时间 开始时间
W

waterlili

Unregistered / Unconfirmed
GUEST, unregistred user!
我有一个文件传输的例子，但是在服务器只能响应一个客户的请求，当另一个客户向服务器传输文件时就会出错，有时是文件传输错乱了。有时就死掉了。
我想应该是服务器端的问题，具体怎么能让他正确的接收到各客户端的文件呢，怎么管理多线程啊？
希望有人可以指教一下，我快疯掉了。
procedure TForm1.ssClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sTemp,sFileName:string;
bufRecv:Pointer;
iLength:Integer;
begin
procedure TForm1.ssClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sTemp,sFileName:string;
bufRecv:Pointer;
iLength:Integer;
begin
for i:=0 to ss.Socket.ActiveConnections-1do
begin

iLength:=Socket.ReceiveLength;
GetMem(bufRecv,iLength);
try
Socket.ReceiveBuf(bufRecv^,iLength);
//
sTemp:=StrPas(PChar(bufRecv));
sTemp:=Copy(sTemp,1,5);
if sTemp=MP_QUERY then
begin
sTemp:=Trim(StrPas(PChar(bufRecv)));
sFileName:=ExtractFileName(Copy(sTemp,6,Length(STemp)));
//在这里拒绝
SaveDialog1.Title:='请选择或输入接收到的数据保存到的文件名：';
SaveDialog1.FileName:=sFileName;
if SaveDialog1.Execute then
begin
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
//如果愿意接收数据。
memo1.Lines.Add ('开始接收！');//??????
TickCount:=GetTickCount;
ss.Socket.Connections.SendText(MP_ACCEPT);
//通知发送端发送数据。
bStart:=False;
end
else
ss.Socket.Connections.SendText(MP_REFUSE+'去死');
end else
if sTemp=MP_FILEPROPERTY then
begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
//iRecvLength:=StrToInt(Copy(sTemp,2,Length(sTemp)));//;1024
ss.Socket.Connections.SendText(MP_NEXTWILLBEDATA);
//接收文件长度并要求继续传送数据。
end else
if sTemp=MP_NEXTWILLBEDATA then
begin
ss.Socket.Connections.SendText(MP_DATA);
//要求发送端发送数据。
//准备好接收数据。
end else
if sTemp=MP_OVER then
begin
memo1.Lines.Add ('MP_OVER');//??????
fsRecv.Free;
end else
if sTemp=MP_END then
//文件传送结束。
begin
memo1.Lines.Add ('结束！'+IntToStr(GetTickCount-TickCount));//??????
fsRecv.Free;
end else
if sTemp=MP_ABORT then
begin
memo1.Lines.Add ('MP_ABORT');//??????
fsRecv.Free;
end else
if sTemp=MP_CHAT then
begin
//Chat Msg
end else
begin
if not bStart then
begin
memo1.Lines.Add('接收数据...');//??????
bStart:=True;
end;
fsRecv.WriteBuffer(bufRecv^,iLength);//
ss.Socket.Connections.sendtext(MP_NEXTWILLBEDATA);
end;
finally
FreeMem(bufRecv,iLength);
//FreeMem(bufRecv,2000);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
ss.Port:=2000;
ss.Open;
end;
iLength:=Socket.ReceiveLength;
GetMem(bufRecv,iLength);
try
Socket.ReceiveBuf(bufRecv^,iLength);
//
sTemp:=StrPas(PChar(bufRecv));
//如果传入的数据有可能不是字符串，需要用其他方式处理，则这里不能及Socket.ReceiveText方法取数据出来检查，
//因为这个方法会清空接收缓冲区，也就是说在执行Socket.ReceiveText方法后，Socket.ReceiveLength将会返回0，
//ReceiveBuf方法也不会取到正确数据。ReceiveBuf方法也是一样的！
//所以在取数据前一定要先把长度取出来，保存在一个变量中。
//请注意判断第一个字符的方法有可能出问题，有可能传送文件的时候正好当前传送段的数据的第一个字节是一个0-9之间的字符。可能会出错。
sTemp:=Copy(sTemp,1,5);
if sTemp=MP_QUERY then
begin
sTemp:=Trim(StrPas(PChar(bufRecv)));
sFileName:=ExtractFileName(Copy(sTemp,6,Length(STemp)));
//在这里拒绝
SaveDialog1.Title:='请选择或输入接收到的数据保存到的文件名：';
SaveDialog1.FileName:=sFileName;
if SaveDialog1.Execute then
begin
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
//如果愿意接收数据。
memo1.Lines.Add ('开始接收！');//??????
TickCount:=GetTickCount;
ss.Socket.Connections.SendText(MP_ACCEPT);
//通知发送端发送数据。
bStart:=False;
end
else
ss.Socket.Connections.SendText(MP_REFUSE+'去死');
end else
if sTemp=MP_FILEPROPERTY then
begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
//iRecvLength:=StrToInt(Copy(sTemp,2,Length(sTemp)));//;1024
ss.Socket.Connections.SendText(MP_NEXTWILLBEDATA);
//接收文件长度并要求继续传送数据。
end else
if sTemp=MP_NEXTWILLBEDATA then
begin
ss.Socket.Connections.SendText(MP_DATA);
//要求发送端发送数据。
//准备好接收数据。
end else
if sTemp=MP_OVER then
begin
memo1.Lines.Add ('MP_OVER');//??????
fsRecv.Free;
end else
if sTemp=MP_END then
//文件传送结束。
begin
memo1.Lines.Add ('结束！'+IntToStr(GetTickCount-TickCount));//??????
fsRecv.Free;
end else
if sTemp=MP_ABORT then
begin
memo1.Lines.Add ('MP_ABORT');//??????
fsRecv.Free;
end else
if sTemp=MP_CHAT then
begin
//Chat Msg
end else
begin
if not bStart then
begin
memo1.Lines.Add('接收数据...');//??????
bStart:=True;
end;
fsRecv.WriteBuffer(bufRecv^,iLength);//
ss.Socket.Connections.sendtext(MP_NEXTWILLBEDATA);
end;
finally
FreeMem(bufRecv,iLength);
//FreeMem(bufRecv,2000);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
ss.Port:=2000;
ss.Open;
end;
 
我有一个文件传输的例子，但是在服务器只能响应一个客户的请求，当另一个客户向服务器传输文件时就会出错，有时是文件传输错乱了。有时就死掉了。
我想应该是服务器端的问题，具体怎么能让他正确的接收到各客户端的文件呢，怎么管理多线程啊？
希望有人可以指教一下，我快疯掉了。
procedure TForm1.ssClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sTemp,sFileName:string;
bufRecv:Pointer;
iLength:Integer;
begin
procedure TForm1.ssClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sTemp,sFileName:string;
bufRecv:Pointer;
iLength:Integer;
begin
for i:=0 to ss.Socket.ActiveConnections-1do
begin

iLength:=Socket.ReceiveLength;
GetMem(bufRecv,iLength);
try
Socket.ReceiveBuf(bufRecv^,iLength);
//
sTemp:=StrPas(PChar(bufRecv));
sTemp:=Copy(sTemp,1,5);
if sTemp=MP_QUERY then
begin
sTemp:=Trim(StrPas(PChar(bufRecv)));
sFileName:=ExtractFileName(Copy(sTemp,6,Length(STemp)));
//在这里拒绝
SaveDialog1.Title:='请选择或输入接收到的数据保存到的文件名：';
SaveDialog1.FileName:=sFileName;
if SaveDialog1.Execute then
begin
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
//如果愿意接收数据。
memo1.Lines.Add ('开始接收！');//??????
TickCount:=GetTickCount;
ss.Socket.Connections.SendText(MP_ACCEPT);
//通知发送端发送数据。
bStart:=False;
end
else
ss.Socket.Connections.SendText(MP_REFUSE+'去死');
end else
if sTemp=MP_FILEPROPERTY then
begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
//iRecvLength:=StrToInt(Copy(sTemp,2,Length(sTemp)));//;1024
ss.Socket.Connections.SendText(MP_NEXTWILLBEDATA);
//接收文件长度并要求继续传送数据。
end else
if sTemp=MP_NEXTWILLBEDATA then
begin
ss.Socket.Connections.SendText(MP_DATA);
//要求发送端发送数据。
//准备好接收数据。
end else
if sTemp=MP_OVER then
begin
memo1.Lines.Add ('MP_OVER');//??????
fsRecv.Free;
end else
if sTemp=MP_END then
//文件传送结束。
begin
memo1.Lines.Add ('结束！'+IntToStr(GetTickCount-TickCount));//??????
fsRecv.Free;
end else
if sTemp=MP_ABORT then
begin
memo1.Lines.Add ('MP_ABORT');//??????
fsRecv.Free;
end else
if sTemp=MP_CHAT then
begin
//Chat Msg
end else
begin
if not bStart then
begin
memo1.Lines.Add('接收数据...');//??????
bStart:=True;
end;
fsRecv.WriteBuffer(bufRecv^,iLength);//
ss.Socket.Connections.sendtext(MP_NEXTWILLBEDATA);
end;
finally
FreeMem(bufRecv,iLength);
//FreeMem(bufRecv,2000);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
ss.Port:=2000;
ss.Open;
end;
iLength:=Socket.ReceiveLength;
GetMem(bufRecv,iLength);
try
Socket.ReceiveBuf(bufRecv^,iLength);
//
sTemp:=StrPas(PChar(bufRecv));
//如果传入的数据有可能不是字符串，需要用其他方式处理，则这里不能及Socket.ReceiveText方法取数据出来检查，
//因为这个方法会清空接收缓冲区，也就是说在执行Socket.ReceiveText方法后，Socket.ReceiveLength将会返回0，
//ReceiveBuf方法也不会取到正确数据。ReceiveBuf方法也是一样的！
//所以在取数据前一定要先把长度取出来，保存在一个变量中。
//请注意判断第一个字符的方法有可能出问题，有可能传送文件的时候正好当前传送段的数据的第一个字节是一个0-9之间的字符。可能会出错。
sTemp:=Copy(sTemp,1,5);
if sTemp=MP_QUERY then
begin
sTemp:=Trim(StrPas(PChar(bufRecv)));
sFileName:=ExtractFileName(Copy(sTemp,6,Length(STemp)));
//在这里拒绝
SaveDialog1.Title:='请选择或输入接收到的数据保存到的文件名：';
SaveDialog1.FileName:=sFileName;
if SaveDialog1.Execute then
begin
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
//如果愿意接收数据。
memo1.Lines.Add ('开始接收！');//??????
TickCount:=GetTickCount;
ss.Socket.Connections.SendText(MP_ACCEPT);
//通知发送端发送数据。
bStart:=False;
end
else
ss.Socket.Connections.SendText(MP_REFUSE+'去死');
end else
if sTemp=MP_FILEPROPERTY then
begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
//iRecvLength:=StrToInt(Copy(sTemp,2,Length(sTemp)));//;1024
ss.Socket.Connections.SendText(MP_NEXTWILLBEDATA);
//接收文件长度并要求继续传送数据。
end else
if sTemp=MP_NEXTWILLBEDATA then
begin
ss.Socket.Connections.SendText(MP_DATA);
//要求发送端发送数据。
//准备好接收数据。
end else
if sTemp=MP_OVER then
begin
memo1.Lines.Add ('MP_OVER');//??????
fsRecv.Free;
end else
if sTemp=MP_END then
//文件传送结束。
begin
memo1.Lines.Add ('结束！'+IntToStr(GetTickCount-TickCount));//??????
fsRecv.Free;
end else
if sTemp=MP_ABORT then
begin
memo1.Lines.Add ('MP_ABORT');//??????
fsRecv.Free;
end else
if sTemp=MP_CHAT then
begin
//Chat Msg
end else
begin
if not bStart then
begin
memo1.Lines.Add('接收数据...');//??????
bStart:=True;
end;
fsRecv.WriteBuffer(bufRecv^,iLength);//
ss.Socket.Connections.sendtext(MP_NEXTWILLBEDATA);
end;
finally
FreeMem(bufRecv,iLength);
//FreeMem(bufRecv,2000);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
ss.Port:=2000;
ss.Open;
end;
 
没有人可以帮帮忙么
 
真的没有人能帮我么/
 
多线程 啊
 
这个不知道对你有没有帮助
unit IEDownload;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ScktComp;
type
Tbufchar=array[0..4095] of char;
Tbufbyte=array[0..4095] of byte;
type
TFileData=Record
FileName:String;
Filebegin
Pos:Integer;
end;
type
TIEDownloadThread=Class(TThread)
private
FClientSocket:TClientSocket;
FRecLength:Integer;
FRelRecLength:Integer;
FTotalLength:Integer;
FPos:Integer;
FBufByte:Tbufbyte;
FBufChar:Tbufchar;
FUrlHost:String;
FUrlFile:String;
FFileName:String;
FUrl:String;
FCanReceive:Bool;
do
wnLoadFile:file;
FThreadIndex:Integer;
FThreadCount:Integer;
FFilePosbegin
:Integer;
FFilePosEnd:Integer;
procedure SetRecLength(const Value: Integer);
procedure SetRelRecLength(const Value: Integer);
procedure SetPos(const Value: Integer);
procedure SetUrlFile(const Value: String);
procedure SetUrlHost(const Value: String);
procedure SetCanReceive(const Value: Bool);
procedure SetTotalLength(const Value: Integer);
procedure SetFileName(const Value: String);
procedure SetThreadIndex(const Value: Integer);
procedure SetFilePosbegin
(const Value: Integer);
procedure SetFilePosEnd(const Value: Integer);
procedure SetThreadCount(const Value: Integer);
procedure GetFilePos();
procedure GetRecLength();
procedure GetFilePosbegin
End();
procedure SetUrl(const Value: String);
function BeforeDownLoad():Bool;
Procedure begin
DownLoad(FilePosbegin
, FilePosEnd: Integer);
Procedure AfterDownLoad();
procedure Execute();
override;
procedure DisPlayMessage(MessageStr:String);
function InitSocket():Boolean;
function FinalSocket():Boolean;
constructor Create(ThreadIndex,ThreadCount:integer);
protected
FileData:TFileData;
public
property TotalLength:Integer read FTotalLength write SetTotalLength;
property RecLength:Integer read FRecLength write SetRecLength;
property RelRecLength:Integer read FRelRecLength write SetRelRecLength;
property FilePos:Integer read FPos write SetPos;
property UrlFile:String read FUrlFile write SetUrlFile;
property UrlHost:String read FUrlHost write SetUrlHost;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
property CanReceive:Bool read FCanReceive write SetCanReceive;
property FileName:String read FFileName write SetFileName;
property Url:String read FUrl write SetUrl;
property ThreadIndex:Integer read FThreadIndex write SetThreadIndex;
property ThreadCount:Integer read FThreadCount write SetThreadCount;
property FilePosbegin
:Integer read FFilePosbegin
write SetFilePosbegin
;
property FilePosEnd:Integer read FFilePosEnd write SetFilePosend;
end;

type
TIEDownload=Class
private
FClientSocket:TClientSocket;
FUrlHost:String;
FUrlFile:String;
FFileName:String;
FTotalLength:Integer;
FBufByte:Tbufbyte;
FBufChar:Tbufchar;
procedure SetFileName(const Value: String);
procedure SetTotalLength(const Value: Integer);
procedure SetUrlFile(const Value: String);
procedure SetUrlHost(const Value: String);
procedure GetUrlHost(Url:String);
procedure GetUrlFile(Url:String);
procedure GetFileName(Url:String);
procedure GetTotalLength();
procedure DisPlayMessage(MessageStr:String);
function InitSocket():Boolean;
function FinalSocket():Boolean;
protected
public
property UrlFile:String read FUrlFile write SetUrlFile;
property UrlHost:String read FUrlHost write SetUrlHost;
property FileName:String read FFileName write SetFileName;
property TotalLength:Integer read FTotalLength write SetTotalLength;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
procedure Start(URL:String);
procedure Stop;
procedure CreateFile;
end;

var
do
wnload:TIEDownload;
do
wnloadThread:Array[1..5] of TIEDownloadThread;
implementation
uses
U_DOWNLOAD;
{ TIEDownloadThread }
////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////IE多线程下载///////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//----------------------------------------------------------------------系统结束
function TIEDownloadThread.FinalSocket: Boolean;
begin
Result:=False;
try
if Assigned(FClientSocket) then
FClientSocket.Free;
Result:=True;
except
end;
end;

//--------------------------------------------------------------------系统初始化
function TIEDownloadThread.InitSocket: Boolean;
begin
Result:=False;
try
if Not Assigned(FClientSocket) then
FClientSocket:=TClientSocket.Create(nil);
FClientSocket.ClientType:=ctBlocking;
Result:=True;
except
end;
end;

//----------------------------------------------------------------取得文件的位置
procedure TIEDownloadThread.GetFilePos;
begin
AssignFile(DownLoadFile,'C:/DOWNLOAD/'+IntToStr(ThreadIndex)+'-'+FileName);
if FileExists('C:/DOWNLOAD/'+IntToStr(ThreadIndex)+'-'+FileName)=True then
begin
Reset(DownLoadFile,1);
FilePos:=FileSize(DownLoadFile);
end else
begin
rewrite(DownLoadFile,1);
FilePos:=0;
end;
Seek(DownLoadFile,FilePos);
DisPlayMessage('线程编号:'+inttostr(ThreadIndex)+'文件开始位置:'+inttostr(FilePos));
end;

//--------------------------------------------------------取得文件应该下载的大小
procedure TIEDownloadThread.GetRecLength;
var
UrlStr:String;
RecLengthOnce:Integer;
FStringStream:TStringStream;
FSocketStream: TWinSocketStream;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
Exit;
end;
CanReceive:=False;
RecLength:=0;
ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
UrlStr:='';
UrlStr:=UrlStr+'GET /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
.NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'RANGE: bytes='+inttostr(0)+'-'+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
ClientSocket.Socket.SendText(UrlStr);
RelRecLength:=0;
FStringStream:=TStringStream.Create('');
FSocketStream:=TWinSocketStream.create(ClientSocket.Socket, 60*1000);
//------------------------------------------取得是否可以下载和要接受的文件的大小
While ClientSocket.Activedo
begin
ZeroMemory(@FBufChar,SizeOf(FBufChar));
RecLengthOnce:=FsocketStream.Read(FBufChar, 1);
if RecLengthOnce=0 then
Break;
FStringStream.Write(FBufChar,RecLengthOnce);
if Pos(#13#10,FStringStream.DataString)<>0 then
begin
if Pos('Content-Length:',FStringStream.DataString)>0 then
begin
RecLength:=StrToInt(Trim(Copy(FStringStream.DataString,Pos(':',FStringStream.DataString)+1,Pos(#13#10,FStringStream.DataString)-Pos(':',FStringStream.DataString)+1)));
end;

if Pos('Content-Range:',FStringStream.DataString)>0 then
begin
CanReceive:=True;
end;
if FStringStream.DataString=#13#10 then
begin
FSocketStream.Free;
FStringStream.Free;
Break;
end;
FStringStream.Free;
FStringStream:=TStringStream.Create('');
end;
end;
end;
end;

//--------------------------------------------------得到文件下载的开始和结束位置
procedure TIEDownloadThread.GetFilePosbegin
end;
var
BufCount:Integer;
BufLeft:Integer;
ThreadBufCount:Integer;
ThreadBufCountLeft:Integer;
I:Integer;
begin
FilePosbegin
:=0;
FilePosEnd:=0;
BufCount:=TotalLength Div Length(FBufByte);
BufLeft:=TotalLength Mod Length(FBufByte);
if BufCount>=5 then
//------------------------------------------------数据块>=5
begin
ThreadBufCount:=BufCount Div 5;
ThreadBufCountLeft:=BufCount Mod 5;
if ThreadBufCountLeft=0 then
begin
if ThreadIndex=5 then
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end else
begin
for i:=1 to ThreadBufCountLeftdo
begin
if ThreadIndex=I then
begin
FilePosbegin
:=FilePos+(ThreadIndex-1)*(ThreadBufCount+1)*Length(FBufByte);
FilePosEnd:=ThreadIndex*(ThreadBufCount+1)*Length(FBufByte)-1;
end;
end;
for I:=ThreadBufCountLeft+1 to 5do
begin
if ThreadIndex=I then
begin
if ThreadIndex=5 then
begin
FilePosbegin
:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)+
BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end;
end;
end;
end else
//------------------------------------------------------------数据块<5
begin
if BufCount=0 then
begin
if ThreadIndex=1 then
begin
FilePosbegin
:=FilePos;
FilePosEnd:=BufLeft-1;
end;
end;

for i:=1 to BufCountdo
begin
if ThreadIndex=I then
begin
if ThreadIndex=BufCount then
begin
FilePosbegin
:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosbegin
:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)-1;
end;
end;
end;
end;
DisPlayMessage('线程编号:'+inttostr(threadindex)
+'文件开始位置:'+inttostr(FilePosbegin
)
+'文件结束位置:'+inttostr(FilePosEnd)
+' '+inttostr(ThreadBufCount)
+' '+inttostr(ThreadBufCountLeft));
end;

constructor TIEDownloadThread.Create(ThreadIndex,ThreadCount:integer);
begin
FThreadIndex:=ThreadIndex;
FThreadCount:=ThreadCount;
Inherited Create(true);
end;

procedure TIEDownloadThread.Execute;
begin
inherited;
if Not BeforeDownLoad then
Exit;
if FilePosbegin
>=FilePosEnd then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
begin
DownLoad(FilePosbegin
,FilePosEnd);
AfterDownLoad;
end;

function TIEDownloadThread.BeforeDownLoad():Bool;
begin
Result:=False;
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
Exit;
end;
do
wnLoadFrm.pb.Max:=TotalLength;
GetFilePos;
GetFilePosbegin
end;
do
wnLoadFrm.pb.Position:=DownLoadFrm.pb.Position+FilePos;
GetRecLength;
if RecLength=0 then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if FilePos=RecLength then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if FileSize(DownLoadFile)>=RecLength then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if CanReceive=false then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
Filedata.FileName:=IntToStr(ThreadIndex)+'-'+FileName;
Filedata.Filebegin
Pos:=FilePosbegin
;
end;
Result:=True;

end;

//------------------------------------------------------------------开始下载文件
procedure TIEDownloadThread.begin
DownLoad(FilePosbegin
, FilePosEnd: Integer);
var
UrlStr:String;
RecLengthOnce:Integer;
FStringStream:TStringStream;
FSocketStream:TWinSocketStream;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
Exit;
end;
ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
UrlStr:='';
UrlStr:=UrlStr+'GET /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
.NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'RANGE: bytes='+inttostr(FilePosbegin
)+'-'+IntToStr(FilePosEnd)+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
DisPlayMessage('线程编号'+inttostr(ThreadIndex)+'文件开始'+inttostr(FilePosbegin
)+'文件结束'+inttostr(FilePosEnd));
ClientSocket.Socket.SendText(UrlStr);
RelRecLength:=0;
FStringStream:=TStringStream.Create('');
FSocketStream:=TWinSocketStream.create(ClientSocket.Socket, 60*1000);
//--------------------------------------------------------------------去掉头文件
While ClientSocket.Activedo
begin
ZeroMemory(@FBufChar,SizeOf(FBufChar));
RecLengthOnce:=FsocketStream.Read(FBufChar, 1);
if RecLengthOnce=0 then
Break;
FStringStream.Write(FBufChar,RecLengthOnce);
if Pos(#13#10,FStringStream.DataString)<>0 then
begin
if FStringStream.DataString=#13#10 then
begin
FSocketStream.Free;
FStringStream.Free;
Break;
end;
FStringStream.Free;
FStringStream:=TStringStream.Create('');
end;
end;
//----------------------------------------------------------------------下载正文
While ClientSocket.Activedo
begin
if FileSize(DownLoadFile)>=RecLength then
Break;
ZeroMemory(@FBufByte,sizeof(FBufByte));
RecLengthOnce:=ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
do
wnLoadFrm.pb.Position:=DownLoadFrm.pb.Position+RecLengthOnce;
BlockWrite(DownLoadFile,FBufByte,RecLengthOnce);
application.ProcessMessages;
end;
DisPlayMessage('文件下载完毕');
ClientSocket.Active:=false;
Closefile(DownLoadFile);
end;
end;

procedure TIEDownloadThread.AfterDownLoad;
begin
end;

procedure TIEDownloadThread.DisPlayMessage(MessageStr: String);
begin
//Form1.Memo1.Lines.Add(MessageStr);
end;

procedure TIEDownloadThread.SetUrlFile(const Value: String);
begin
FUrlFile := Value;
end;

procedure TIEDownloadThread.SetUrlHost(const Value: String);
begin
FUrlHost := Value;
end;

procedure TIEDownloadThread.SetPos(const Value: Integer);
begin
FPos := Value;
end;

procedure TIEDownloadThread.SetRecLength(const Value: Integer);
begin
FRecLength := Value;
end;

procedure TIEDownloadThread.SetRelRecLength(const Value: Integer);
begin
FRelRecLength := Value;
end;

procedure TIEDownloadThread.SetCanReceive(const Value: Bool);
begin
FCanReceive := Value;
end;

procedure TIEDownloadThread.SetTotalLength(const Value: Integer);
begin
FTotalLength := Value;
end;

procedure TIEDownloadThread.SetFileName(const Value: String);
begin
FFileName := Value;
end;

procedure TIEDownloadThread.SetUrl(const Value: String);
begin
FUrl := Value;
end;

procedure TIEDownloadThread.SetThreadIndex(const Value: Integer);
begin
FThreadIndex := Value;
end;

procedure TIEDownloadThread.SetFilePosbegin
(const Value: Integer);
begin
FFilePosbegin
:= Value;
end;

procedure TIEDownloadThread.SetFilePosEnd(const Value: Integer);
begin
FFilePosEnd := Value;
end;

procedure TIEDownloadThread.SetThreadCount(const Value: Integer);
begin
FThreadCount := Value;
end;

{ TIEDownload }
//--------------------------------------------------------------------系统初始化
function TIEDownload.InitSocket: Boolean;
begin
Result:=False;
try
if Not Assigned(FClientSocket) then
FClientSocket:=TClientSocket.Create(nil);
FClientSocket.ClientType:=ctBlocking;
Result:=True;
except
end;
end;

//----------------------------------------------------------------------系统结束
function TIEDownload.FinalSocket: Boolean;
begin
Result:=False;
try
if Assigned(FClientSocket) then
FClientSocket.Free;
Result:=True;
except
end;
end;

//-----------------------------------------------------------------取得URL文件名
procedure TIEDownload.GetUrlFile(Url: String);
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
If pos('/',UrlStr)<>0 then
begin
UrlStr:=copy(UrlStr,pos('/',UrlStr)+1,length(UrlStr));
end;
UrlFile:=UrlStr;
end;

//-----------------------------------------------------------------取得URL文件名
Procedure TIEDownload.GetFileName(Url:String);
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
While pos('/',UrlStr)<>0do
begin
UrlStr:=copy(UrlStr,pos('/',UrlStr)+1,length(UrlStr));
end;
FileName:=UrlStr;
end;

//-------------------------------------------------------------------取得URL地址
procedure TIEDownload.GetUrlHost(Url: String);
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
if pos('/',UrlStr)<>0 then
begin
UrlStr:=copy(UrlStr,0,pos('/',UrlStr)-1);
end;
UrlHost:=UrlStr;
end;

//----------------------------------------------------------------取得文件总长度
procedure TIEDownload.GetTotalLength;
var
UrlStr:String;
UrlHead:String;
RecLengthOnce:Integer;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) then
begin
TotalLength:=0;
Exit;
end;

ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
UrlStr:='';
UrlStr:=UrlStr+'HEAD /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
.NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
ClientSocket.Socket.SendText(UrlStr);
ZeroMemory(@FBufByte,sizeof(FBufByte));
RecLengthOnce:=ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
UrlHead:='';
UrlHead:=strpas(@FBufByte);
application.ProcessMessages;
ClientSocket.Active:=false;
if Pos('Content-Length:',UrlHead)>0 then
begin
UrlHead:=Copy(UrlHead,Pos('Content-Length:',UrlHead),Length(UrlHead)-Pos('Content-Length:',UrlHead)+1);
TotalLength:=StrToInt(Trim(Copy(UrlHead,Pos(':',UrlHead)+1,Pos(#13#10,UrlHead)-Pos(':',UrlHead)+1)));
end else
begin
TotalLength:=0;
end;
end;
displaymessage('文件总长度:'+inttostr(TotalLength));
end;

procedure TIEDownload.Start(URL: String);
var
I:Integer;
begin
try
GetUrlFile(Url);
GetUrlHost(Url);
GetFileName(Url);
GetTotalLength;
for i:=1 to 5do
begin
do
wnloadThread:=TIEDownloadThread.Create(i,5);
do
wnloadThread.UrlFile:=UrlFile;
do
wnloadThread.UrlHost:=UrlHost;
do
wnloadThread.FileName:=FileName;
do
wnloadThread.TotalLength:=TotalLength;
do
wnloadThread.Resume;
end;
except
end;
end;

procedure TIEDownload.Stop;
var
I:Integer;
begin
try
for i:=1 to 5do
begin
do
wnloadThread.Suspend;
end;
except
end;
end;

procedure TIEDownload.CreateFile;
var
I:Integer;
f1,f2:file;
str:TstringList;
str1:TMemoryStream;
filename:string;
begin
str:=TstringList.Create;
str1:=TMemoryStream.Create;
for i:=1 to 5do
begin
filename:='C:/download/'+inttostr(i)+'-'+'20050815-008-i32.exe';
str.LoadFromFile(filename);
str1.CopyFrom(str,Lengty(Str))
end;
str1.SaveToFile('c:/download/1.exe');
end;

procedure TIEDownload.DisPlayMessage(MessageStr: String);
begin
//Form1.Memo1.Lines.Add(MessageStr);
end;

procedure TIEDownload.SetFileName(const Value: String);
begin
FFileName := Value;
end;

procedure TIEDownload.SetTotalLength(const Value: Integer);
begin
FTotalLength := Value;
end;

procedure TIEDownload.SetUrlFile(const Value: String);
begin
FUrlFile := Value;
end;

procedure TIEDownload.SetUrlHost(const Value: String);
begin
FUrlHost := Value;
end;

end.
 
无论有没有帮助。都感谢你的热心。给分了
 
您必须登录或注册才可回复。

Similar threads

大
传输文件的问题,很简单的,分太少，没人理我[:(] (50分)
回复
9
查看
234
大傻
大
梨
帮忙解决点对点传输文件的问题!(50分)
回复
1
查看
181
antic_ant
A
C
救命啊，一个晚上没搞定，文件传输的问题， (150分)
回复
15
查看
209
coao
C
梨
p to p 文件发送!怎么没人理我啊?(20分)
回复
1
查看
165
antic_ant
A
梨
点对点发送文件的程序中出现的问题!网络高手,快帮我!(100分)
回复
5
查看
226
梨皮
梨
后退
顶部