How to use TIdLogFile (Indy 10) in a thread?
Elund Christensen
begin
Debug:=TIdLogFile.Create(Owner);
Debug.Filename:= 'c:\temp\FTP_test_debug.log';
Debug.Active:= true;
DebugIOHandler:= TIdIOHandlerStack.Create(Owner);
DebugIOHandler.Intercept:= Debug;
FTPClient:=TidFTP.Create(Owner);
FTPClient.IOHandler:=DebugIOHandler;
FTPClient.Host:= '127.0.0.1';
FTPClient.Username:= 'User';
FTPClient.Password:= 'UserPassword';
FTPClient.Connect;
end;
But when running in a thread using TCriticalSection there is no output in
the logfile and the communicaton to an FTP-Server does not work any longer.
I looks like that problem(s) has something to do with this line:
FTPClient.IOHandler:=DebugIOHandler;
When removing this line there are no communication problems to the
FTP-server.
Any suggestions for a solution on using TIdLogFile (Indy 10) in a thread?
Best regards,
Elund
Remy Lebeau (TeamB)
"Elund Christensen" <nosp...@eegholm.dk> wrote in message
news:42a99a0f$1...@newsgroups.borland.com...
> But when running in a thread using TCriticalSection there is
> no output in the logfile and the communicaton to an FTP-Server
> does not work any longer.
Please be more specific. Just saying it doesn't work says nothing at all
about the actual problem you are having. What does the rest of your code
look like? And why are you using a critical section?
> I looks like that problem(s) has something to do with this line:
>
> FTPClient.IOHandler:=DebugIOHandler;
I seriously doubt that is the problem. TIdIOHandlerStack is the default
IOHandler for Indy. If you do not provide your own IOHandler, Connect()
instantiates TIdIOHandlerStack internally.
Gambit
Elund
>> But when running in a thread using TCriticalSection there is
>> no output in the logfile and the communicaton to an FTP-Server
>> does not work any longer.
>
> Please be more specific. Just saying it doesn't work says nothing at all
> about the actual problem you are having. What does the rest of your code
> look like? And why are you using a critical section?
A few times the application can actually communicate to the FTP-server, when
the line 'FTPClient.IOHandler:=DebugIOHandler' is present.
But in both cases there are no output to the logfile.
I am trying to implement TIdLogFile to find errors in the FTP-communication.
Are there any specific things to take into consideration when using
TIdLogFile in a multithreaded application?
Removing the critical section does not make any difference regarding the
missing output to the logfile.
I have not written the application myself, so to be more specific I have to
do some more investigations.
>
>> I looks like that problem(s) has something to do with this line:
>>
>> FTPClient.IOHandler:=DebugIOHandler;
>
> I seriously doubt that is the problem. TIdIOHandlerStack is the default
> IOHandler for Indy. If you do not provide your own IOHandler, Connect()
> instantiates TIdIOHandlerStack internally.
OK, I did not know that. I will try NOT to provide my own IOHandler to see
if it makes any difference.
Best regards, Elund
Remy Lebeau (TeamB)
"Elund" <elund...@person.dk> wrote in message
news:42ab...@newsgroups.borland.com...
> A few times the application can actually communicate to the
> FTP-server, when the line 'FTPClient.IOHandler:=DebugIOHandler'
> is present. But in both cases there are no output to the logfile.
The only way that can happen is if either the Intercept is not active, or
the IOHandler is not reading/writing any data at all. Neither one is likely
to be happening, so there has to be something else involved that you have
not taken into account yet. That is why I asked you to show your actual
code.
> Are there any specific things to take into consideration when
> using TIdLogFile in a multithreaded application?
Don't use the same file for multiple connections. TIdLogFile does not
access its log file in a thread-safe manner. Each conection would need to
have its own unique filename.
> Removing the critical section does not make any difference
> regarding the missing output to the logfile.
I cannot comment on that since you still have not shown that code yet.
> OK, I did not know that. I will try NOT to provide my own IOHandler
> to see if it makes any difference.
You will have to provide your own IOHandler in order to attach an Intercept
to it prior to connecting to the server. Otherwise, the IOHandler will not
be valid until after Connect() returns, which means your logging will miss
out on everything that Connect() does internally. The point I was trying to
make is that your code is creating a TIdIOHandlerStack, and Indy already
uses that same class internally if you do not provide your own, so simply
assigning your own IOHandler should not be effecting your code's ability to
run, and attaching an Intercept should not be effecting the IOHandler's
ability to operate once the connection is established.
Gambit
Elund
unit SFtpTrd;
(*
upload/download file(s) like this:
URL1:='//username:password@@host:port/documentnameandpath;type=type'
Job:=TCommJob.Create(JobID, ftp_download (or ftp_upload));
Job.AddTask(URL1, LocalFileName1);
Job.AddTask(URL2, LocalFileName2);
...
FtpThread.StartJob(Job);
while Job.GetStatus<>ftp_ok
(do other stuff)
(done)
Job.Free;
*)
interface
uses
Windows, classes, scktcomp, extctrls, SysUtils, SyncObjs, SAF, Tools,
idFTP, IdLogFile, IdIOHandlerStack, RASCon, CommJob, ThreadEx,
IdFTPCommon;
type TSFtpThread = class(TThreadEx)
private
lbDirectory: TStringList;
Debug: TIdLogFile;
DebugIOHandler: TIdIOHandlerStack;
FTPClient: TidFtp;
JobList: TList; //list of CommJobs
TmpFilename: TFilename;
JobSection: TCriticalSection;
TreeLevel: integer;
ForcedHost: string; //default = ''
CommCounter: longint;
LastCommCounter: longint;
SilenceStart: TDatetime;
function ProcessJob(CommJob: TCommJob): boolean;
protected
procedure Execute; override;
function Upload(Local, Remote: AnsiString): boolean;
function DownloadTree(LocalRoot: string; Flags: integer): boolean;
function UploadTree( LocalRoot: string; Flags: integer;
Pattern: string='*.*';
SL: TStringList=nil): boolean;
//event handlers...
procedure Error(Sender: TComponent; Errno: Word; Errmsg: String);
procedure PacketSuccess(Sender: TObject);
public
constructor Create(Owner: TComponent; RASEntry: string);
destructor Destroy; override;
function StartJob(CommJob: TCommJob): boolean;
procedure SetForcedHost(host: string);
procedure Abort(var Retry: boolean);
function Timeout(): boolean;
end;
implementation
uses
LogEx, FileCtrl, ErrorCodes, Winsock, CCVar, ccb_main;
constructor TSFtpThread.Create(Owner: TComponent; RASEntry: string);
begin
JobSection:=TCriticalSection.Create;
// Implementing a logfile for debugging to FTPClient
Debug:=TIdLogFile.Create(Owner);
Debug.Filename:= 'c:\temp\FTP_test_debug.log';
Debug.Active:= true;
DebugIOHandler:= TIdIOHandlerStack.Create(Owner);
DebugIOHandler.Intercept:= Debug;
FTPClient:=TidFTP.Create(Owner);
FTPClient.TransferTimeout:=10000;
// Providing my own IOHandler in order to attach an Intercept
FTPClient.IOHandler:=DebugIOHandler;
JobList:=TList.Create;
lbDirectory:=TStringList.Create;
TmpFilename:=AppRoot+'Upload.tmp';
inherited Create(false); // execute immediately
end;
destructor TSFtpThread.Destroy;
begin
try
FTPClient.Disconnect;
except
end;
FTPClient.Free;
JobList.Clear;
JobList.Free;
lbDirectory.Free;
JobSection.Free;
inherited Destroy;
end;
procedure TSFtpThread.Error(Sender: TComponent; Errno: Word; Errmsg:
String);
begin
ThreadLog(LOG_DEBUG,'('+IntToStr(Errno)+') '+Errmsg);
Form1.EFIFO.CCBox(DT_FTP,1,EC_FTP_ERROR,Errmsg,EC_ERROR);
end;
procedure TSFtpThread.PacketSuccess(Sender: TObject);
begin
Inc(CommCounter,1); //(avoid timeout)
end;
//---
procedure TSFtpThread.SetForcedHost(host: string);
begin
ForcedHost:=Host;
end;
function TSFtpThread.StartJob(CommJob: TCommJob): boolean;
begin
JobSection.Enter;
JobList.Add(CommJob);
JobSection.Leave;
SilenceStart:=Now; //reset timeout timer
result:=true;
end;
function TSFtpThread.Upload(Local, Remote: AnsiString): boolean;
var
hFile: THandle;
begin
try
Result:=true;
if local=TmpFilename then //don't send the internal work file
exit;
if not FileExists(local) then
exit;
ThreadLog(LOG_DEBUG,'Upload: '+Local+' -> '+Remote);
//try to open file to see if we would get a shareing problem with the
ftp component
hFile:=CreateFile( PChar(Local),
GENERIC_READ,
0, // not shared !
nil, // default security descriptor
OPEN_EXISTING, // open only existing
FILE_ATTRIBUTE_NORMAL, // no attributes
0 // no overlapping
);
if hFile = INVALID_HANDLE_VALUE then //would upload fail ?
begin
//send a copy of the file instead...
if not CopyFile(PChar(Local),PChar(TmpFilename),false) then
begin
Result:=false;
ThreadLog(LOG_DEBUG,'Unable to copy source file: '+Local+' to:
'+TmpFilename);
exit;
end;
Local:=TmpFilename;
end
else
CloseHandle(hFile);
FTPClient.Put(Local,Remote);
DeleteFile(TmpFilename);
except
Result:=false;
ThreadLog(LOG_DEBUG,'Upload error (FTPClient.TransactionReply)');
end;
end;
//---
function TSFtpThread.DownloadTree(LocalRoot: string; Flags: integer):
boolean;
(*
space in filenames is not supported !!!
wildcards not supported !!!
(starts in current directory on ftp server)
*)
var
i: integer;
s: string;
attr: string;
begin
result:=false;
try
lbDirectory.Clear;
FTPClient.List(lbDirectory, '', false);
ForceDirectories(LocalRoot);
for i:=0 to lbDirectory.Count-1 do
begin
s:=lbDirectory[i];
if (s='.') or (s='..') then
continue;
attr:='FTPClient.FTPDirectoryList.Attribute[i]';
ThreadLog(LOG_DEBUG,'DLTree entity: '+s+' ('+attr+')');
if pos('d',attr)>0 then //directory ?
begin
if (Flags and FTP_SUBFOLDERS) <> 0 then
begin
FTPClient.ChangeDir(s);
try
if not DownloadTree(LocalRoot+s+'\', Flags) then //scan subdirs
exit;
finally
FTPClient.ChangeDir('..');
lbDirectory.Clear;
FTPClient.List(lbDirectory, '', false);
end;
end
else //no sub folders (create folders in current dir only)
if (Flags and FTP_FOLDERS) <> 0 then
ForceDirectories(LocalRoot+s+'\');
end
else //file:
try
if (Flags and FTP_FILES) <> 0 then
FTPClient.Get(s,LocalRoot+s);
except
end;
end;
result:=true;
except
ThreadLog(LOG_DEBUG,'FTPClient.TransactionReply');
end;
end;
function FormatFileTime(FT: TFileTime): string;
var
ST: TSystemTime;
begin
FileTimeToSystemTime(FT,ST);
result:=Format('%4.4u-%2.2u-%2.2u
%2.2u:%2.2u',[ST.wYear,ST.wMonth,ST.wDay,ST.wHour,ST.wMinute]);
end;
function TSFtpThread.UploadTree( LocalRoot: string; Flags: integer;
Pattern: string='*.*';
SL: TStringList=nil): boolean;
(*
Starts in current directory on FTP server
*)
var
SearchRec: TSearchRec;
Indent: string;
i: integer;
ModifyHost: boolean;
begin
result:=false;
ModifyHost:= ((Flags and FTP_LIST_NAMES) = 0);
if Pattern='' then Pattern:='*.*';
if SL<>nil then
begin
if TreeLevel=0 then
begin
SL.Add('------------------+--------+--------------+-------------------------------------');
SL.Add(' Modified | Attr | Size [bytes] | Name');
SL.Add('------------------+--------+--------------+-------------------------------------');
end;
Indent:='';
for i:=1 to TreeLevel do
Indent:=Indent+' ';
Inc(TreeLevel);
end;
try
if SysUtils.FindFirst(LocalRoot+Pattern, faAnyFile, SearchRec)=0 then
try
repeat
if (SearchRec.Name='.') or (SearchRec.Name='..') then
continue;
if (SearchRec.Attr and faDirectory) <> 0 then //directory ?
begin
if (Flags and FTP_LIST_NAMES) <> 0 then
if (Flags and FTP_FOLDERS) <> 0 then
SL.Add( '
'+FormatFiletime(SearchRec.FindData.ftLastWriteTime)+
' |
0x'+IntToHex(SearchRec.FindData.dwFileAttributes,4)+' |'+
Format(' <dir> %6.6s |
%s\',[IntToStr(SearchRec.Size),Indent+SearchRec.Name]) );
if (Flags and FTP_SUBFOLDERS) <> 0 then
begin
if ModifyHost then
begin
try
FTPClient.ChangeDir(SearchRec.Name);
except
FTPClient.MakeDir(SearchRec.Name);
FTPClient.ChangeDir(SearchRec.Name);
end;
end;
if not UploadTree(LocalRoot+SearchRec.Name+'\',Flags,Pattern,SL)
then //scan subdirs
exit;
if ModifyHost then
FTPClient.ChangeDir('..');
end
else //no sub folders: (folders in current dir only)
if (Flags and FTP_FOLDERS) <> 0 then
try
if ModifyHost then
FTPClient.MakeDir(SearchRec.Name);
except
end;
end
else //file:
begin
//upload file...
if (Flags and FTP_FILES) <> 0 then
begin
if ModifyHost then
Upload(LocalRoot+SearchRec.Name,SearchRec.Name)
else
SL.Add( '
'+FormatFiletime(SearchRec.FindData.ftLastWriteTime)+
' |
0x'+IntToHex(SearchRec.FindData.dwFileAttributes,4)+' |'+
Format('%13.13s |
%s',[IntToStr(SearchRec.Size),Indent+SearchRec.Name]) );
end;
end;
until FindNext(SearchRec) <> 0;
result:=true;
finally
SysUtils.FindClose(SearchRec);
end;
finally
Dec(TreeLevel);
end;
end;
function TSFtpThread.ProcessJob(CommJob: TCommJob): boolean; //calls upload,
download, etc.
var
URL,
Username,
Password,
Host,
Localname,
Filename: string;
Port: Integer;
i: Integer;
LastResult: TFtpResult;
s: string;
SearchRec: TSearchRec;
LastPath: TFilename;
NewFTPPath: boolean;
SL: TStringList;
begin
Result:=false;
LastResult:=ftp_ok;
LastPath:='Pigs fly'; // ;o)
try //>>> RAS connected >>>
while(CommJob.GetTask(URL,Localname,LastResult)) do //while task left in
job
begin
LastResult:=ftp_error; //(will generate false warning)
if not DecodeFtpURL(URL,Username,Password,Host,Filename,Port) then
continue;
FTPClient.Username:=UserName;
FTPClient.Password:=Password;
if ForcedHost='' then
FTPClient.Host:=Host
else
FTPClient.Host:=ForcedHost;
FTPClient.Port:=Port;
NewFTPPath:=ExtractFilePath(URL)<>LastPath; //not same
user,password,host,port or path ?
if NewFTPPath then
begin
try
FTPClient.Disconnect;
except
end;
try
ThreadLog(LOG_DEBUG,'Connecting...');
FTPClient.Connect;
FTPClient.TransferType := ftBinary; //binary transfer
except
ThreadLog(LOG_DEBUG, 'Connect error:
'+FTPClient.Host+':'+IntToStr(FTPClient.Port)+
' (FTPClient.TransactionReply)');
continue;
end;
end;
try //>>> connected >>>
if NewFTPPath then
begin
//change dir if needed...
try
i:=AnsiPos('/', FileName);
while i>0 do
begin
s:=Copy(Filename, 1, i-1);
if s<>'' then
begin
try
FTPClient.ChangeDir(s);
except
FTPClient.MakeDir(s);
FTPClient.ChangeDir(s);
end;
end;
Delete(Filename, 1, i);
i:=AnsiPos('/', FileName);
end;
except
ThreadLog(LOG_DEBUG,'FTP illegal filename: '+URL+'
(FTPClient.TransactionReply)');
continue;
end;
end
else
Filename:=ExtractFilename(StringReplace(Filename,'/','\',[rfReplaceAll]));
//execute task...
try
case CommJob.GetCommand of
ftp_download: FTPClient.Get(Filename,LocalName);
//------------------------------------------------------------------
ftp_upload: if not Upload(LocalName,Filename) then continue;
//------------------------------------------------------------------
ftp_download_dir:
begin
lbDirectory.Clear;
FTPClient.List(lbDirectory, '*.*', false);
ThreadLog(LOG_DEBUG, 'Download dir:
'+FTPClient.RetrieveCurrentDir);
for i:=0 to lbDirectory.Count-1 do
begin
s:=lbDirectory[i];
if (s<>'.') and (s<>'..') then
begin
ThreadLog(LOG_DEBUG,'Download: '+s+' -> '+LocalName+s);
FTPClient.Get( s, LocalName+s);
end;
end;
end;
//------------------------------------------------------------------
ftp_upload_wildcard:
begin
if FindFirst(LocalName, faReadOnly+faSysFile+faArchive,
SearchRec)=0 then
try
repeat
Upload(ExtractFilePath(LocalName)+SearchRec.Name,
SearchRec.Name);
until FindNext(SearchRec) <> 0;
finally
FindClose(SearchRec);
end;
end;
//------------------------------------------------------------------
ftp_upload_tree:
begin
if (CommJob.GetFlags and FTP_LIST_NAMES) <> 0 then
begin
TreeLevel:=0;
SL:=TStringList.Create;
try
if not UploadTree( ExtractFilePath(LocalName),
CommJob.GetFlags,
ExtractFileName(LocalName),
SL) then //start in current FTP dir
continue;
finally
SL.SaveToFile(AppRoot+'ftplist.txt');
SL.Free;
end;
Upload(AppRoot+'ftplist.txt','list.txt');
end
else
if not UploadTree( ExtractFilePath(LocalName),
CommJob.GetFlags,
ExtractFileName(LocalName)) then //start
in current FTP dir
continue;
end;
//------------------------------------------------------------------
ftp_download_tree:
begin
if not DownloadTree(LocalName,CommJob.GetFlags) then //start
in current FTP dir
continue;
end;
end; //case
except
continue;
end;
finally //<<< connected <<<
end;
//task complete:
LastResult:=ftp_ok;
LastPath:=ExtractFilePath(URL);
end; //while
finally //<<< RAS connected <<<
if LastResult<>ftp_ok then
ThreadLog(LOG_DEBUG, 'CommJob '+IntToStr(CommJob.GetCommJobID)+ '
failed: FTPClient.TransactionReply')
else
ThreadLog(LOG_DEBUG,'CommJob '+IntToStr(CommJob.GetCommJobID)+'
complete.');
try
FTPClient.Disconnect;
except
ThreadLog(LOG_DEBUG,'Disconnect (except)');
end;
end;
end;
procedure TSFtpThread.Abort(var Retry: boolean);
var
s1,s2: string;
i: integer;
begin
if not Retry then
if JobList.Count=0 then
begin
exit;
end;
Retry:=not Retry;
try
JobSection.Enter;
for i:=0 to JobList.Count-1 do
TCommJob(JobList[i]).GetTask(s1,s2,ftp_error); //set commjob error
JobList.Clear;
JobSection.Leave;
finally
try
FTPClient.Abort; //abort current task
finally
try
sleep(1000);
FTPClient.Quit; //Cancel; //cancel socket (PSock) operation
finally
end;
end;
end;
end;
function TSFtpThread.Timeout(): boolean;
begin
result:=false;
JobSection.Enter; //---
if JobList.Count>0 then //working ?
begin
If LastCommCounter=CommCounter then
begin
if (Now-SilenceStart)>SECONDS_15 then //timeout ?
begin
Form1.EFIFO.CCBox(DT_FTP,1,EC_FTP_TIMEOUT,'',EC_ERROR);
result:=true;
end;
end
else
SilenceStart:=Now;
LastCommCounter:=CommCounter;
end
else
SilenceStart:=Now;
JobSection.Leave; //---
end;
procedure TSFtpThread.Execute;
begin
FreeOnTerminate:=true;
SetThreadInfo('FTP','FTP Thread');
SetThreadStatus('Waiting...');
while not Terminated do
begin
// wait for something to do...
while (JobList.Count=0) and (not terminated) do
Sleep(1000);
SilenceStart:=Now; //reset timeout timer
JobSection.Enter;
if JobList.Count>0 then
begin
JobSection.Leave;
SetThreadStatus('Processing...');
ThreadLog(LOG_DEBUG,'CommJob-ID:
'+IntToStr(TCommJob(JobList.First).GetCommJobID));
// Find file to process...
ProcessJob(JobList.First);
JobSection.Enter;
if JobList.Count>0 then
JobList.Remove(JobList.First);
JobSection.Leave;
SetThreadStatus('Waiting...');
end
else
JobSection.Leave;
end;
end;
end.