X
xiaoyue_a
Unregistered / Unconfirmed
GUEST, unregistred user!
我只有245分 大侠照顾一下我这新手啊
我写了一个(根据网上的改的)可是局域网内传文件时只有每秒几百k的速度,请高手指导:
服务器端代码:使用TIdTCPServer的默认属性
type
TDataState = (dstNone, dstReceiving);
//Data对象用来保存一个连接的状态以及一些变量
TThreadData = class
private
FState: TDataState;
FFileSize: Int64;
FStream: TFileStream;
procedure SetState(const Value: TDataState);
procedure SetFileSize(const Value: Int64);
procedure SetStream(const Value: TFileStream);
public
constructor Create;
destructor Destroy; override;
property State: TDataState read FState write SetState;
property FileSize: Int64 read FFileSize write SetFileSize;
property Stream: TFileStream read FStream write SetStream;
end;
procedure TThreadData.SetState(const Value: TDataState);
begin
FState := Value;
end;
procedure TThreadData.SetFileSize(const Value: Int64);
begin
FFileSize := Value;
end;
procedure TThreadData.SetStream(const Value: TFileStream);
begin
FStream := Value;
end;
constructor TThreadData.Create;
begin
inherited;
Stream := nil;
end;
destructor TThreadData.Destroy;
begin
if Assigned(Stream) then
Stream.Free;
inherited;
end;
//idtcpserver的OnConnect属性:
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
AThread.Data := TThreadData.Create;
with AThread.Data as TThreadData do
begin
State := dstNone;
end;
end;
//idtcpserver的OnExecute属性:
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
aFileSize, ASize: Int64;
aFileName, RequestType, cmd: string;
Buff: array[0..9999] of Byte;
ReadCount: Int64;
begin
with AThread.Data as TThreadData do
begin
if State = dstNone then
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
//读取文件名
aFileName := AThread.Connection.ReadLn(#13#10, 100);
if aFileName = '' then
exit;
Forcedirectories(ExtractFileDir(aFileName));
//返回确认文件传输标志
AThread.Connection.WriteLn;
//开始读取文件长度,创建文件
AThread.Connection.ReadBuffer(aFileSize, 8);
FileSize := aFileSize;
Forcedirectories(ExtractFileDir(aFileName));
Stream := TFileStream.Create(aFileName, fmCreate);
State := dstReceiving;
end
end;
if not AThread.Terminated and AThread.Connection.Connected then
begin
//读取文件流
repeat
cmd := UpperCase(AThread.Connection.ReadLn);
if cmd = 'CONTINUE' then
begin
if FileSize - Stream.Size > SizeOf(Buff) then
ReadCount := SizeOf(Buff)
else
ReadCount := FileSize - Stream.Size;
AThread.Connection.ReadBuffer(Buff, ReadCount);
Stream.WriteBuffer(Buff, ReadCount);
Application.ProcessMessages;
end;
if cmd = 'CANCEL' then
begin
Break;
end;
until Stream.Size >= FileSize;
if cmd = 'CONTINUE' then
AThread.Connection.WriteLn('OK');
if cmd = 'CANCEL' then
AThread.Connection.WriteLn('HASCANCEL');
Stream.Free;
Stream := nil;
State := dstNone;
end;
end;
end;
//------------------------------------------------------------------------
客户端用的是线程,代码如下
unit UnitTcpUpload;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
StdCtrls, ComCtrls, ComObj, IdException, UnitUpload, UnitMain, UnitCommFun,
DateUtils;
type
TcpUpload = class(TThread)
private
crow: Integer;
DataListView: TListView;
ProBar: TProgressBar;
SourceDir: string;
protected
procedure Execute; override;
procedure TCPSendToSvr;
public
constructor Create(ListView: TListView; citem: Integer; cpb: TProgressBar; SourceRootOnSvr: string);
end;
implementation
//要上传文件列表放在ListView中,
//citem是指出当前传lilstview中第citem行所记录的文件,
//SourceRootOnSvr指明文件要放在服务器的那个位置
constructor TcpUpload.Create(ListView: TListView; citem: Integer; cpb: TProgressBar; SourceRootOnSvr: string);
begin
inherited Create(false);
FreeOnTerminate := true;
DataListView := ListView;
crow := citem;
ProBar := cpb;
SourceDir := SourceRootOnSvr;
end;
procedure TcpUpload.TCPSendToSvr;
var
Buf: array[0..9999] of Byte;
aSize, ReadCount, Tmpint: int64;
aStream: TFileStream;
aIdTCPClient: TIdTCPClient;
SendEndFlag, RequestAnswer: string;
begintime, ctime: TDateTime;
begin
try
aIdTCPClient := TIdTCPClient.Create(Application);
try
aIdTCPClient.Port := 5555;
aIdTCPClient.Host := FrmMain.ClientSocket1.Host;
aIdTCPClient.Connect(5000);
try
try
aStream := TFileStream.Create(DataListView.Items.Item[crow].caption, fmOpenRead or fmShareDenyWrite);
//发送文件名
aIdTCPClient.WriteLn(SourceDir + DataListView.Items.Item[crow].SubItems.Strings[4]);
//等待接受确认
aIdTCPClient.ReadLn(#13#10, 1000);
//写文件长度和文件流
aSize := aStream.Size;
if aSize > 1024 * 1024 * 1024 then
ProBar.Max := Trunc(aSize / 1024)
else
ProBar.Max := aSize;
aIdTCPClient.WriteBuffer(aSize, 8);
begintime := Now; //计算速度时使用
while aStream.Position < aStream.Size do
begin
if FrmUpload.UpLoadCancel = false then
begin
aIdTCPClient.WriteLn('CONTINUE');
if aStream.Size - aStream.Position >= SizeOf(Buf) then
ReadCount := SizeOf(Buf)
else
ReadCount := aStream.Size - aStream.Position;
aStream.ReadBuffer(Buf, ReadCount);
aIdTCPClient.WriteBuffer(Buf, ReadCount);
if aSize > 1024 * 1024 * 1024 then
ProBar.Position := Trunc(aStream.Position / 1024)
else
ProBar.Position := aStream.Position;
//平均速度
ctime := Now;
//为防止每传一次都计算速度,这样影响传送速度,每隔10000000字节计算一次
if ((aStream.Position mod 10000000)=0) and (MilliSecondsBetween(begintime, ctime) > 0) then
DataListView.Items.Item[crow].SubItems.Strings[3]
:= IntToStr(Trunc(((aStream.Position) / MilliSecondsBetween(begintime, ctime)) * 1000 / 1024)) + 'K/S';
end
else
begin
aIdTCPClient.WriteLn('CANCEL');
break;
end;
end;
SendEndFlag := aIdTCPClient.ReadLn(#13#10, 1000);
if SendEndFlag = 'OK' then
DataListView.Items.Item[crow].SubItems.Strings[3] := '成功'
else if SendEndFlag = 'HASCANCEL' then
begin
DataListView.Items.Item[crow].SubItems.Strings[3] := '入库取消';
FrmUpload.UpLoadCancel := true;
end
else if (SendEndFlag = '') or (aIdTCPClient.ReadLnTimedOut = true) then
begin
DataListView.Items.Item[crow].SubItems.Strings[3] := '失败';
FrmUpload.UploadFileErr := true;
end;
finally
if aStream <> nil then FreeAndNil(aStream);
aIdTCPClient.Disconnect;
end;
except
on e: EIdSocketError do
begin
Application.messagebox('服务器链接失败!', '提示信息', MB_ICONERROR + mb_ok + mb_defbutton1);
end;
end;
except
Application.messagebox('服务器链接失败!', '提示信息', MB_ICONERROR + mb_ok + mb_defbutton1);
end;
finally
if aIdTCPClient <> nil then FreeAndNil(aIdTCPClient);
end;
end;
procedure TcpUpload.Execute;
begin
//Synchronize(TCPSendToSvr);
TCPSendToSvr;
end;
end.
我写了一个(根据网上的改的)可是局域网内传文件时只有每秒几百k的速度,请高手指导:
服务器端代码:使用TIdTCPServer的默认属性
type
TDataState = (dstNone, dstReceiving);
//Data对象用来保存一个连接的状态以及一些变量
TThreadData = class
private
FState: TDataState;
FFileSize: Int64;
FStream: TFileStream;
procedure SetState(const Value: TDataState);
procedure SetFileSize(const Value: Int64);
procedure SetStream(const Value: TFileStream);
public
constructor Create;
destructor Destroy; override;
property State: TDataState read FState write SetState;
property FileSize: Int64 read FFileSize write SetFileSize;
property Stream: TFileStream read FStream write SetStream;
end;
procedure TThreadData.SetState(const Value: TDataState);
begin
FState := Value;
end;
procedure TThreadData.SetFileSize(const Value: Int64);
begin
FFileSize := Value;
end;
procedure TThreadData.SetStream(const Value: TFileStream);
begin
FStream := Value;
end;
constructor TThreadData.Create;
begin
inherited;
Stream := nil;
end;
destructor TThreadData.Destroy;
begin
if Assigned(Stream) then
Stream.Free;
inherited;
end;
//idtcpserver的OnConnect属性:
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
AThread.Data := TThreadData.Create;
with AThread.Data as TThreadData do
begin
State := dstNone;
end;
end;
//idtcpserver的OnExecute属性:
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
aFileSize, ASize: Int64;
aFileName, RequestType, cmd: string;
Buff: array[0..9999] of Byte;
ReadCount: Int64;
begin
with AThread.Data as TThreadData do
begin
if State = dstNone then
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
//读取文件名
aFileName := AThread.Connection.ReadLn(#13#10, 100);
if aFileName = '' then
exit;
Forcedirectories(ExtractFileDir(aFileName));
//返回确认文件传输标志
AThread.Connection.WriteLn;
//开始读取文件长度,创建文件
AThread.Connection.ReadBuffer(aFileSize, 8);
FileSize := aFileSize;
Forcedirectories(ExtractFileDir(aFileName));
Stream := TFileStream.Create(aFileName, fmCreate);
State := dstReceiving;
end
end;
if not AThread.Terminated and AThread.Connection.Connected then
begin
//读取文件流
repeat
cmd := UpperCase(AThread.Connection.ReadLn);
if cmd = 'CONTINUE' then
begin
if FileSize - Stream.Size > SizeOf(Buff) then
ReadCount := SizeOf(Buff)
else
ReadCount := FileSize - Stream.Size;
AThread.Connection.ReadBuffer(Buff, ReadCount);
Stream.WriteBuffer(Buff, ReadCount);
Application.ProcessMessages;
end;
if cmd = 'CANCEL' then
begin
Break;
end;
until Stream.Size >= FileSize;
if cmd = 'CONTINUE' then
AThread.Connection.WriteLn('OK');
if cmd = 'CANCEL' then
AThread.Connection.WriteLn('HASCANCEL');
Stream.Free;
Stream := nil;
State := dstNone;
end;
end;
end;
//------------------------------------------------------------------------
客户端用的是线程,代码如下
unit UnitTcpUpload;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
StdCtrls, ComCtrls, ComObj, IdException, UnitUpload, UnitMain, UnitCommFun,
DateUtils;
type
TcpUpload = class(TThread)
private
crow: Integer;
DataListView: TListView;
ProBar: TProgressBar;
SourceDir: string;
protected
procedure Execute; override;
procedure TCPSendToSvr;
public
constructor Create(ListView: TListView; citem: Integer; cpb: TProgressBar; SourceRootOnSvr: string);
end;
implementation
//要上传文件列表放在ListView中,
//citem是指出当前传lilstview中第citem行所记录的文件,
//SourceRootOnSvr指明文件要放在服务器的那个位置
constructor TcpUpload.Create(ListView: TListView; citem: Integer; cpb: TProgressBar; SourceRootOnSvr: string);
begin
inherited Create(false);
FreeOnTerminate := true;
DataListView := ListView;
crow := citem;
ProBar := cpb;
SourceDir := SourceRootOnSvr;
end;
procedure TcpUpload.TCPSendToSvr;
var
Buf: array[0..9999] of Byte;
aSize, ReadCount, Tmpint: int64;
aStream: TFileStream;
aIdTCPClient: TIdTCPClient;
SendEndFlag, RequestAnswer: string;
begintime, ctime: TDateTime;
begin
try
aIdTCPClient := TIdTCPClient.Create(Application);
try
aIdTCPClient.Port := 5555;
aIdTCPClient.Host := FrmMain.ClientSocket1.Host;
aIdTCPClient.Connect(5000);
try
try
aStream := TFileStream.Create(DataListView.Items.Item[crow].caption, fmOpenRead or fmShareDenyWrite);
//发送文件名
aIdTCPClient.WriteLn(SourceDir + DataListView.Items.Item[crow].SubItems.Strings[4]);
//等待接受确认
aIdTCPClient.ReadLn(#13#10, 1000);
//写文件长度和文件流
aSize := aStream.Size;
if aSize > 1024 * 1024 * 1024 then
ProBar.Max := Trunc(aSize / 1024)
else
ProBar.Max := aSize;
aIdTCPClient.WriteBuffer(aSize, 8);
begintime := Now; //计算速度时使用
while aStream.Position < aStream.Size do
begin
if FrmUpload.UpLoadCancel = false then
begin
aIdTCPClient.WriteLn('CONTINUE');
if aStream.Size - aStream.Position >= SizeOf(Buf) then
ReadCount := SizeOf(Buf)
else
ReadCount := aStream.Size - aStream.Position;
aStream.ReadBuffer(Buf, ReadCount);
aIdTCPClient.WriteBuffer(Buf, ReadCount);
if aSize > 1024 * 1024 * 1024 then
ProBar.Position := Trunc(aStream.Position / 1024)
else
ProBar.Position := aStream.Position;
//平均速度
ctime := Now;
//为防止每传一次都计算速度,这样影响传送速度,每隔10000000字节计算一次
if ((aStream.Position mod 10000000)=0) and (MilliSecondsBetween(begintime, ctime) > 0) then
DataListView.Items.Item[crow].SubItems.Strings[3]
:= IntToStr(Trunc(((aStream.Position) / MilliSecondsBetween(begintime, ctime)) * 1000 / 1024)) + 'K/S';
end
else
begin
aIdTCPClient.WriteLn('CANCEL');
break;
end;
end;
SendEndFlag := aIdTCPClient.ReadLn(#13#10, 1000);
if SendEndFlag = 'OK' then
DataListView.Items.Item[crow].SubItems.Strings[3] := '成功'
else if SendEndFlag = 'HASCANCEL' then
begin
DataListView.Items.Item[crow].SubItems.Strings[3] := '入库取消';
FrmUpload.UpLoadCancel := true;
end
else if (SendEndFlag = '') or (aIdTCPClient.ReadLnTimedOut = true) then
begin
DataListView.Items.Item[crow].SubItems.Strings[3] := '失败';
FrmUpload.UploadFileErr := true;
end;
finally
if aStream <> nil then FreeAndNil(aStream);
aIdTCPClient.Disconnect;
end;
except
on e: EIdSocketError do
begin
Application.messagebox('服务器链接失败!', '提示信息', MB_ICONERROR + mb_ok + mb_defbutton1);
end;
end;
except
Application.messagebox('服务器链接失败!', '提示信息', MB_ICONERROR + mb_ok + mb_defbutton1);
end;
finally
if aIdTCPClient <> nil then FreeAndNil(aIdTCPClient);
end;
end;
procedure TcpUpload.Execute;
begin
//Synchronize(TCPSendToSvr);
TCPSendToSvr;
end;
end.