tidtcp控件传输文件的问题:跪求高手指路(200分)

  • 主题发起人 主题发起人 xiaoyue_a
  • 开始时间 开始时间
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.
 
代码也实在贴得太长了些没法看啊,这样很难解决问题的
 
这样看好累。你加QQ ,把程序发出来
 
我的qq:24826316
 
运行了。家里没有网络环境。我在想,本机可以速度很快,
那么是不是应该考虑,是否是什么参数影响了网络上的传输速度。
你使用控件(不使用多线程),单独测试传输速度?
怀疑是不是你动态的控件参数的问题,
 
查查网内有没有过滤程序先。发的东西一过滤速度马上慢
 
我又测了好多次,发现程序运行时cpu的占用很高。我用一台p42.0内存1g的机器测每秒只有900多k,cpu一直占满;用1台p42.8内存1g的传0.8517g的文件平均每秒约6425k,cup占用在60%左右。高手们指教这是什么原因啊?
 
多人接受答案了。
 
原因
1、网络确实存在问题,重装了机器;
2、每发送一个数据块前的aIdTCPClient.WriteLn('CONTINUE')耗时,我去掉了;
3、显示速度频率高时影响发送速度。
修改后测试结果:
服务器192.168.200.1:CPU 3.0G; 1G RAM;运行瑞星;cpu占用15%左右,内存占用237M左右
客户端192.168.200.5:CPU 3.0G; 1G RAM;运行瑞星;cpu占用40%左右,内存占用330M左右
文件大小 耗时(秒)平均速度(K/S)
2.6674 300 9323.238741
4.9432 540 9598.742376

峰值在1300K/S左右
 
后退
顶部