那
那锦渤
Unregistered / Unconfirmed
GUEST, unregistred user!
iDFTP是由线程动态创建的,当线程用
MyThread: TthrdWork;
if TerminateThread(MyThread.Handle, 0) then
MyTread.Free
方式强制终止时,线程执行了Destroy事件,按理说程序应当释放了下载文件的控制,可是此时,如果试图删除这个尚未下载完的文件,后出现被别的程序使用的提示,这种情况直到整个程序的终止。 正常下载完后的文件则没有这个问题, 请诸位指点迷津。以下是这个线程的部分代码。
type
TthrdWork = class(TThread)
private
IDFTP: TIDFTP;
LogEvents: TIdLogEvent;
LogList: TStringList;
URL, Folder, SavePos, DisplayMsg: string;
Mode: integer;
STime: TDateTime;
BytesToTransfer: LongWord;
AverageSpeed:do
uble;
AbortTransfer: boolean;
procedure DisplayThreadState;
procedure IdFTPWork(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdFTPWorkbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdFTPWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
procedure LogEventsReceived(ASender: TComponent;
const AText, AData: String);
procedure LogEventsSent(ASender: TComponent;
const AText, AData: String);
procedure PutToUploadLog(Direct,LogMsg: string);
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(WorkID: integer;
FTPHost, FTPUserName, FTPPWD, FileURL,
FoldPosition, SaveName: string;
FTPPort: integer;
OperationMode: integer);
virtual;
destructor Destroy;
override;
end;
implementation
uses CommUse;
{ TthrdWork }
procedure TthrdWork.DisplayThreadState;
begin
end;
procedure TthrdWork.IdFTPWork(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
Var
TotalTime: TDateTime;
H, M, Sec, MS: Word;
DLTime:do
uble;
begin
TotalTime := Now - STime;
DecodeTime(TotalTime, H, M, Sec, MS);
Sec := Sec + M * 60 + H * 3600;
DLTime := Sec + MS / 1000;
if DLTime > 0 then
AverageSpeed := (AWorkCount / 1024) / DLTime;
if AverageSpeed > 0 then
begin
DisplayMsg := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
DisplayMsg := 'Time remaining ' + DisplayMsg;
end
else
DisplayMsg := '';
DisplayMsg := FormatFloat('0.00 KB/s', AverageSpeed) + ';
' + DisplayMsg;
case AWorkMode of
wmRead: DisplayMsg := 'Download speed ' + DisplayMsg;
wmWrite: DisplayMsg := 'Uploade speed ' + DisplayMsg;
end;
if AbortTransfer then
begin
IDFTP.Abort;
AbortTransfer:= false;
end;
Synchronize(DisplayThreadState);
end;
procedure TthrdWork.IdFTPWorkbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
STime:= Now;
BytesToTransfer:= 0;
AverageSpeed:= 0;
end;
procedure TthrdWork.IdFTPWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
BytesToTransfer:= 0;
AverageSpeed:= 0;
end;
procedure TthrdWork.LogEventsReceived(ASender: TComponent;
const AText,
AData: String);
begin
PutToUploadLog('<<-', AData);
end;
procedure TthrdWork.LogEventsSent(ASender: TComponent;
const AText,
AData: String);
begin
PutToUploadLog('->>', AData);
end;
procedure TthrdWork.PutToUploadLog(Direct, LogMsg: string);
var
TempStr: string;
begin
if LogList.Count = Max_LogKeepRow then
LogList.Delete(0);
if Length(LogMsg) > 0 then
if Pos(#13, LogMsg) > 0 then
begin
TempStr := Copy(LogMsg, 1, Pos(#13, LogMsg) - 1);
Delete(LogMsg, 1, Pos(#13, LogMsg));
if LogMsg[1] = #10 then
Delete(LogMsg, 1, 1);
end
else
TempStr := LogMsg;
LogList.Add(Direct + TempStr);
end;
constructor TthrdWork.Create(WorkID: integer;
FTPHost, FTPUserName, FTPPWD, FileURL,
FoldPosition, SaveName: string;
FTPPort: integer;
OperationMode: integer);
begin
inherited Create(true);
try
LogList:= TStringList.Create;
LogEvents:= TIdLogEvent.Create(nil);
with LogEventsdo
begin
Onreceived:= LogEventsReceived;
OnSent:= LogeventsSent;
end;
IdFTP:= TIDFTP.Create(nil);
with IdFTPdo
begin
Host:= FTPHost;
Username:= FTPUserName;
Password:= FTPPWD;
Port:= FTPPort;
Passive:= true;
Intercept:= LogEvents;
TransferType:= ftASCII;
OnWork:= IDFTPWork;
OnWorkbegin
:= IDFTPWorkbegin
;
OnWorkEnd:= IDFTPWorkend;
end;
except
on E: Exceptiondo
begin
PutToUploadLog('->>', E.Message);
Terminate;
end;
end;
URL:= FileURL;
Folder:= FoldPosition;
Mode:= OperationMode;
SavePos:= SaveName;
end;
destructor TthrdWork.Destroy;
var
List: TList;
begin
AbortTransfer:= true;
try
try
if IDFTP.Connected then
IDFTP.Disconnect;
except
on E: Exceptiondo
PutToUploadLog('->>', E.Message);
end;
List:= WorkThreadList.LockList;
List.Remove(self);
finally
WorkThreadList.UnlockList;
FreeAndNil(LogList);
FreeAndNil(LogEvents);
FreeAndNil(IDFTP);
end;
inherited;
end;
procedure TthrdWork.Execute;
begin
FreeOnTerminate:= true;
with IDFTPdo
try
Connect(true, 30000);
ChangeDir(Folder);
TransferType:= ftBinary;
case Mode of
0: Put(URL, ExtractFileName(URL), true);
1: Get(URL, SavePos, true);
end;
TransferType:= ftASCII;
except
on E: Exceptiondo
PutToUploadLog('->>', E.Message);
end;
end;
end.
MyThread: TthrdWork;
if TerminateThread(MyThread.Handle, 0) then
MyTread.Free
方式强制终止时,线程执行了Destroy事件,按理说程序应当释放了下载文件的控制,可是此时,如果试图删除这个尚未下载完的文件,后出现被别的程序使用的提示,这种情况直到整个程序的终止。 正常下载完后的文件则没有这个问题, 请诸位指点迷津。以下是这个线程的部分代码。
type
TthrdWork = class(TThread)
private
IDFTP: TIDFTP;
LogEvents: TIdLogEvent;
LogList: TStringList;
URL, Folder, SavePos, DisplayMsg: string;
Mode: integer;
STime: TDateTime;
BytesToTransfer: LongWord;
AverageSpeed:do
uble;
AbortTransfer: boolean;
procedure DisplayThreadState;
procedure IdFTPWork(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdFTPWorkbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdFTPWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
procedure LogEventsReceived(ASender: TComponent;
const AText, AData: String);
procedure LogEventsSent(ASender: TComponent;
const AText, AData: String);
procedure PutToUploadLog(Direct,LogMsg: string);
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(WorkID: integer;
FTPHost, FTPUserName, FTPPWD, FileURL,
FoldPosition, SaveName: string;
FTPPort: integer;
OperationMode: integer);
virtual;
destructor Destroy;
override;
end;
implementation
uses CommUse;
{ TthrdWork }
procedure TthrdWork.DisplayThreadState;
begin
end;
procedure TthrdWork.IdFTPWork(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCount: Integer);
Var
TotalTime: TDateTime;
H, M, Sec, MS: Word;
DLTime:do
uble;
begin
TotalTime := Now - STime;
DecodeTime(TotalTime, H, M, Sec, MS);
Sec := Sec + M * 60 + H * 3600;
DLTime := Sec + MS / 1000;
if DLTime > 0 then
AverageSpeed := (AWorkCount / 1024) / DLTime;
if AverageSpeed > 0 then
begin
DisplayMsg := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
DisplayMsg := 'Time remaining ' + DisplayMsg;
end
else
DisplayMsg := '';
DisplayMsg := FormatFloat('0.00 KB/s', AverageSpeed) + ';
' + DisplayMsg;
case AWorkMode of
wmRead: DisplayMsg := 'Download speed ' + DisplayMsg;
wmWrite: DisplayMsg := 'Uploade speed ' + DisplayMsg;
end;
if AbortTransfer then
begin
IDFTP.Abort;
AbortTransfer:= false;
end;
Synchronize(DisplayThreadState);
end;
procedure TthrdWork.IdFTPWorkbegin
(Sender: TObject;
AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
STime:= Now;
BytesToTransfer:= 0;
AverageSpeed:= 0;
end;
procedure TthrdWork.IdFTPWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
BytesToTransfer:= 0;
AverageSpeed:= 0;
end;
procedure TthrdWork.LogEventsReceived(ASender: TComponent;
const AText,
AData: String);
begin
PutToUploadLog('<<-', AData);
end;
procedure TthrdWork.LogEventsSent(ASender: TComponent;
const AText,
AData: String);
begin
PutToUploadLog('->>', AData);
end;
procedure TthrdWork.PutToUploadLog(Direct, LogMsg: string);
var
TempStr: string;
begin
if LogList.Count = Max_LogKeepRow then
LogList.Delete(0);
if Length(LogMsg) > 0 then
if Pos(#13, LogMsg) > 0 then
begin
TempStr := Copy(LogMsg, 1, Pos(#13, LogMsg) - 1);
Delete(LogMsg, 1, Pos(#13, LogMsg));
if LogMsg[1] = #10 then
Delete(LogMsg, 1, 1);
end
else
TempStr := LogMsg;
LogList.Add(Direct + TempStr);
end;
constructor TthrdWork.Create(WorkID: integer;
FTPHost, FTPUserName, FTPPWD, FileURL,
FoldPosition, SaveName: string;
FTPPort: integer;
OperationMode: integer);
begin
inherited Create(true);
try
LogList:= TStringList.Create;
LogEvents:= TIdLogEvent.Create(nil);
with LogEventsdo
begin
Onreceived:= LogEventsReceived;
OnSent:= LogeventsSent;
end;
IdFTP:= TIDFTP.Create(nil);
with IdFTPdo
begin
Host:= FTPHost;
Username:= FTPUserName;
Password:= FTPPWD;
Port:= FTPPort;
Passive:= true;
Intercept:= LogEvents;
TransferType:= ftASCII;
OnWork:= IDFTPWork;
OnWorkbegin
:= IDFTPWorkbegin
;
OnWorkEnd:= IDFTPWorkend;
end;
except
on E: Exceptiondo
begin
PutToUploadLog('->>', E.Message);
Terminate;
end;
end;
URL:= FileURL;
Folder:= FoldPosition;
Mode:= OperationMode;
SavePos:= SaveName;
end;
destructor TthrdWork.Destroy;
var
List: TList;
begin
AbortTransfer:= true;
try
try
if IDFTP.Connected then
IDFTP.Disconnect;
except
on E: Exceptiondo
PutToUploadLog('->>', E.Message);
end;
List:= WorkThreadList.LockList;
List.Remove(self);
finally
WorkThreadList.UnlockList;
FreeAndNil(LogList);
FreeAndNil(LogEvents);
FreeAndNil(IDFTP);
end;
inherited;
end;
procedure TthrdWork.Execute;
begin
FreeOnTerminate:= true;
with IDFTPdo
try
Connect(true, 30000);
ChangeDir(Folder);
TransferType:= ftBinary;
case Mode of
0: Put(URL, ExtractFileName(URL), true);
1: Get(URL, SavePos, true);
end;
TransferType:= ftASCII;
except
on E: Exceptiondo
PutToUploadLog('->>', E.Message);
end;
end;
end.