Hi Bernd
Am 13.07.2011 um 21:06 schrieb Bernd:
> Because I have no idea how to do this properly (It has been a hundred
> years since I last used this form of file IO in Pascal) I have done
> the following hack, just to get it running somehow but now I wonder
> what would be the proper way to do this. How can I do something like a
> hypothetical IsOpen(StdOut) the proper way? This is what I have done
> but I don't like it:
>
> implementation
> var
> HasOutput: Boolean = True;
>
> procedure log(const s: String);
> begin
> if HasOutput then
> writeln(s);
> end;
>
> initialization
> try
> writeln();
> except
> HasOutput := False;
> end;
> end.
The subject indicates that you look for a solution for normal files but your
example indicates that you what to detect the console. So I add my solutions
for both.
function HasConsole: Boolean;
// This function tests if there is a console. If GetStdHandle() reports that
there is a console when in fact there
// isn't (as in Matlab R2008a), we still need to check if writing to the output
handle works to get the right answer.
begin
// In Free Pascal V2.4.0 STD_*_HANDLE seem to be defined in a way that it is
not directly usable for WIN64 target. In
// the source rtl\win\syswin.inc, procedure SysInitStdIO() there is Cardinal()
(which is the type of STD_*_HANDLE in
// Delphi) around the handles.
Result := ((GetStdHandle({$IFDEF WIN64}Cardinal{$ENDIF}(STD_INPUT_HANDLE)) <>
0) and
(GetStdHandle({$IFDEF WIN64}Cardinal{$ENDIF}(STD_OUTPUT_HANDLE)) <>
0));
if (Result) then
try
write('');
except
on EInOutError do begin
Result := False;
end;
end;
end;
For normal files I have:
function FileIOMode(var F: Text): Word;
begin
case TTextRec(F).Mode of
fmClosed,
fmInput,
fmOutput,
fmInOut : Result := TTextRec(F).Mode;
// There is no 'fmUnknown' to indicate this ;-) I assume this mean 'handle
never used before'.
else Result := fmClosed;
end;
end;
(Same function for untyped files: replace 'Text' by 'file' and ' TTextRec' by
'TFileRec')
And in the code you can write
If (FileIOMode(Foo) <> fmClosed) then
...
Regards
Michael_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
