paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 18:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* better handling of error output for gui programs

Browse Source 
git-svn-id: trunk@10867 -
This commit is contained in:
florian 2008-05-02 18:43:43 +00:00
parent ff9273bf0d
commit 577d26b290
1 changed files with 18 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
rtl/win32/system.pp
View File

@ -1017,34 +1017,24 @@ var
p : pchar; p : pchar;
i : longint; i : longint;
Begin Begin
if F.BufPos>0 then while F.BufPos>0 do
begin
if F.BufPos+ErrorLen>ErrorBufferLength then
i:=ErrorBufferLength-ErrorLen
else
i:=F.BufPos;
Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
inc(ErrorLen,i);
ErrorBuf[ErrorLen]:=#0;
end;
if ErrorLen>3 then
begin
p:=@ErrorBuf[ErrorLen];
for i:=1 to 4 do
begin
dec(p);
if not(p^ in [#10,#13]) then
break;
end;
end;
if ErrorLen=ErrorBufferLength then
i:=4;
if (i=4) then
begin begin
MessageBox(0,@ErrorBuf,pchar('Error'),0); begin
ErrorLen:=0; if F.BufPos+ErrorLen>ErrorBufferLength then
i:=ErrorBufferLength-ErrorLen
else
i:=F.BufPos;
Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
inc(ErrorLen,i);
ErrorBuf[ErrorLen]:=#0;
end;
if ErrorLen=ErrorBufferLength then
begin
MessageBox(0,@ErrorBuf,pchar('Error'),0);
ErrorLen:=0;
end;
Dec(F.BufPos,i);
end; end;
F.BufPos:=0;
ErrorWrite:=0; ErrorWrite:=0;
End; End;
@ -1066,6 +1056,7 @@ Begin
TextRec(F).InOutFunc:=@ErrorWrite; TextRec(F).InOutFunc:=@ErrorWrite;
TextRec(F).FlushFunc:=@ErrorWrite; TextRec(F).FlushFunc:=@ErrorWrite;
TextRec(F).CloseFunc:=@ErrorClose; TextRec(F).CloseFunc:=@ErrorClose;
ErrorLen:=0;
ErrorOpen:=0; ErrorOpen:=0;
End; End;
@ -1088,7 +1079,7 @@ begin
if not IsConsole then if not IsConsole then
begin begin
AssignError(stderr); AssignError(stderr);
AssignError(stdout); AssignError(StdOut);
Assign(Output,''); Assign(Output,'');
Assign(Input,''); Assign(Input,'');
Assign(ErrOutput,''); Assign(ErrOutput,'');