<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
</head>
<body bgcolor="#ffffff" text="#000000">
<font face="Helvetica, Arial, sans-serif">Dear All.<br>
<br>
Currently to implement logger we use the following approach (the code
was implemented for Delphi/Kylix/FPC).<br>
Logger is intended for displaying in the GUI outputs of several threads
and child processes and also for storage into internal bases.<br>
<br>
Logic is the following:<br>
<br>
Get stdout handle (duplicate it under linux), <br>
create pipe,<br>
replace the stdout (keeping the old stdout) for current process with
write handle of pipe,<br>
<br>
There are following problems with FPC<br>
Under Windows: I have to call <b>rewrite(output) </b>for every thread
which wants to use new (captured) stdout<br>
<br>
So the questions: <br>
How to force all the threads of process and all DLLs write into same
captured stdout? <br>
How to revert stdout back (stop capturing)?<br>
<br>
procedure TLogger.Start;<br>
{$IFDEF LINUX}<br>
{$ifdef fpc}<br>
type TPipeDescriptors=TFilDes;<br>
{$endif}<br>
var<br>
pds:TPipeDescriptors;<br>
{$ENDIF} <br>
begin<br>
if fCaptureStdout then<br>
{$IFDEF MSWINDOWS}<br>
hConsole := GetStdHandle(STD_OUTPUT_HANDLE);<br>
{$ELSE}<br>
{$ifdef fpc}<br>
hConsole := fpdup(StdOutputHandle);;//stdout;<br>
{$else}<br>
hConsole := dup(STDOUT_FILENO);;//stdout;<br>
{$endif}<br>
{$ENDIF}<br>
<br>
{$IFDEF MSWINDOWS}<br>
CreatePipe(hReadPipe, hWritePipe, nil, 0);<br>
{$ENDIF}<br>
<br>
{$IFDEF LINUX}<br>
{$ifdef fpc}<br>
fppipe(pds);<br>
hReadPipe:=pds[0];<br>
hWritePipe:=pds[1];<br>
{$else}<br>
pipe(pds);<br>
hReadPipe:=pds.ReadDes;<br>
hWritePipe:=pds.WriteDes;<br>
{$endif}<br>
{$ENDIF}<br>
<br>
if fCaptureStdout then<br>
begin<br>
{$IFDEF MSWINDOWS}<br>
if not SetStdHandle(STD_OUTPUT_HANDLE, hWritePipe)<br>
then MessageBox(0,PChar(Format('Function: SetStdHandle(%x,%x),
Error: %d',[STD_OUTPUT_HANDLE, hWritePipe, GetLastError])),'Failed',0);<br>
{$IFDEF fpc}<br>
<b> StdOutputHandle:=hWritePipe; // modify global runtime handle</b><br>
{$ENDIF}<br>
if GetStdHandle(STD_OUTPUT_HANDLE)<>hWritePipe then<br>
begin<br>
safeputs('Looks like SetStdHandle failed in Windows 7, will try
AllocConsole workaround'#13#10,hWritePipe);<br>
if not fWinConsole then<br>
begin<br>
AllocConsole;<br>
FreeConsole;<br>
SetStdHandle(STD_OUTPUT_HANDLE, hWritePipe);<br>
end;<br>
if GetStdHandle(STD_OUTPUT_HANDLE)<>hWritePipe then<br>
begin<br>
safeputs('AllocConsole workaround failed, will use
GlobalWritePipe workaround'#13#10,hWritePipe);<br>
GlobalWritePipe:=hWritePipe;<br>
TTextRec(output).Handle:=hWritePipe;<br>
end;<br>
end;<br>
<b>rewrite(output);</b><br>
{$ENDIF}<br>
{$IFDEF LINUX}<br>
{$ifdef fpc}<br>
fpdup2(hWritePipe, StdOutputHandle);<br>
{$else}<br>
dup2(hWritePipe, STDOUT_FILENO);<br>
{$endif}<br>
{$ENDIF}<br>
end; <br>
end;<br>
<br>
<br>
finalizing capture made via<br>
<br>
procedure TLogger.Stop;<br>
var dummy:integer;<br>
{$IFDEF LINUX}<br>
p:pointer;<br>
{$ENDIF}<br>
begin<br>
if fExitFlag then Exit;<br>
<br>
fExitFlag := True;<br>
<br>
// make empty write to wake up the thread sleeping on read operation<br>
dummy:=0;<br>
FileWrite(hWritePipe,dummy,1);<br>
<br>
if hThread<>0 then<br>
begin<br>
{$IFDEF MSWINDOWS}<br>
if WaitForSingleObject(hThread,2000)=WAIT_TIMEOUT<br>
then begin<br>
TerminateThread(hThread,0);<br>
MessageBeep(UINT(-1));<br>
writeln('Thread was terminated abnormally');<br>
end;<br>
Closehandle(hThread);<br>
{$ENDIF}<br>
{$IFDEF LINUX}<br>
{$ifndef FPC} // Kylix<br>
pthread_join(hThread,nil); //Unfortunately, will wait INFINITEly<br>
pthread_detach(hThread);<br>
{$else}<br>
WaitForThreadTerminate (hThread, 2000); // implies pthread_join<br>
KillThread(hThread); // implies pthread_detach and pthread_kill<br>
{$endif}<br>
{$ENDIF}<br>
hThread:=0;<br>
end;<br>
<br>
if fCaptureStdout then<br>
begin<br>
{$IFDEF MSWINDOWS}<br>
SetStdHandle(STD_OUTPUT_HANDLE, hConsole);<br>
if GlobalWritePipe = hWritePipe then
GlobalWritePipe:=INVALID_HANDLE_VALUE;<br>
{$ENDIF}<br>
{$IFDEF LINUX}<br>
{$ifdef fpc}<br>
fpdup2(hConsole, StdOutputHandle);<br>
{$else}<br>
dup2(hConsole, STDOUT_FILENO);<br>
{$endif}<br>
{$ENDIF}<br>
rewrite(output);<br>
end;<br>
<br>
if hReadPipe <> 0 then<br>
begin<br>
FileClose(hReadPipe);<br>
hReadPipe := 0;<br>
end;<br>
<br>
if hWritePipe <> 0 then<br>
begin<br>
FileClose(hWritePipe);<br>
hWritePipe := 0;<br>
end;<br>
<br>
<br>
if IsLogFileOpened then<br>
begin<br>
FileClose(hLogFile);<br>
hLogFile := 0;<br>
end;<br>
end;<br>
<br>
<br>
<br>
<br>
<br>
</font>
</body>
</html>