[fpc-pascal] Procedures that work like WRITELN()

Wayne Sherman wsherman at gmail.com
Thu Dec 28 00:42:17 CET 2023


Example using a TFileStream descendant and StreamIO AssignStream:

program TeeStdOut;
{$mode objfpc}

uses
  Classes, SysUtils, StreamIO;

type
  TTeeStream = class(TFileStream)
  Private
    FOriginalStdOut: Text;
    FNewStdOut: Text;
  public
    constructor Create(const AFileName: string; Mode: Word);
    destructor Destroy; override;
    function Write(const Buffer; Count : Longint) : Longint; override;
  end;

constructor TTeeStream.Create(const AFileName: string; Mode: Word);
begin
  inherited Create(AFileName, Mode);

  FOriginalStdOut := Output; // save original stdout
  AssignStream(FNewStdOut, Self);
  Rewrite(FNewStdOut);

  // The following code causes stdout to be redirected
  //   to FNewStdOut (and our TTeeStream)
  Output := FNewStdOut;
end;

destructor TTeeStream.Destroy;
begin
  Output := FOriginalStdOut;
  Close(FNewStdOut);
  inherited Destroy;
end;

function TTeeStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := inherited Write(Buffer, Count);
//  FileWrite(System.StdOutPutHandle, Buffer, Count); //this also works
  FileWrite(TextRec(Output).Handle, Buffer, Count);
end;

var
  TeeStream: TTeeStream;
begin
  WriteLn('WriteLn to stdout before TTeeStream redirect');

  TeeStream := TTeeStream.Create('test.txt', fmCreate);
  try
    WriteLn('Hello, World! after creating TTeeStream');
    WriteLn('(WriteLn to stdout redirected to console and to file)');
  finally
    TeeStream.Free;
  end;

  WriteLn('WriteLn to stdout after destroying TTeeStream');
end.

On Wed, Dec 27, 2023 at 3:25 AM James Richters via fpc-pascal
<fpc-pascal at lists.freepascal.org> wrote:
>
> I wanted to write what I thought should be a simple procedure, just instead of calling WRITELN() with some arguments,
>
> call WRITELOG() with the same arguments that you would use to write to a file, but my WRITELOG() procedure would
>
> write to the screen and the file.. but I can’t figure out how to pass all the arguments to the two WRTIELNs.
>
>
>
> So….
>
>
>
> Procedure WriteLog(Filename:String, AllOtherAurguments:????);
>
> Begin
>
>     Writeln(Filename,AllOtherAurguments);
>
>     Writeln(AllOtherAurguments);
>
> End;
>
>
>
> How can I make this work?  Since WRITELN can take any number of many kinds of arguments,
>
> how can I get them all and pass them along without knowing how many or what types they are?
>
> How does WRITELN even work when you don’t know this information?
>
>
>
> I’m guessing there should be some way to do this, because WRITELN itself works, but how it could
>
> possibly work is not within my experience.
>
>
>
> The only way I could think of would be if there were versions of WRITELN with every combination
>
> of possible arguments, but that seems completely unmanageable and ridiculous,
>
> so there must be something more advanced going on, but maybe WRTELN is special and not something I can duplicate?
>
>
>
>
>
> Any Ideas?
>
>
>
> James
>
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal


More information about the fpc-pascal mailing list