Text von Writeln -> Speicherblock

[negaH]

Delphi-Quellcode:

procedure AssignHook(var F: Text);

  function DeviceOpen(var F: TTextRec): Integer; register;
  begin
    Result := 0;
  end;

  function DeviceClose(var F: TTextRec): Integer; register;
  begin
    Result := 0;
    F.BufPtr^ := #0;
    F.BufEnd := 1;
    F.BufPos := 0;
  end;

  function DeviceFlush(var F: TTextRec): Integer; register;
  begin
    Result := 0;
    case F.Mode of
      fmInput:
        begin
          // ouput F.BufPtr^ here
          F.BufPtr^ := #0;
          F.BufEnd := 1;
          F.BufPos := 0;
        end;
      fmOutput:
        begin
          // ouput F.BufPtr^ here
          F.BufPtr^ := #0;
          F.BufEnd := 1;
          F.BufPos := 0;
        end;
    end;
  end;

  function DeviceInOut(var F: TTextRec): Integer; register;
  begin
    Result := 0;
    case F.Mode of
      fmInput: // read F.Buffer here in
      fmOutput: // output F.Buffer here
    end;
  end;


begin
  with TTextRec(F) do
  begin
    FillChar(F, SizeOf(F), 0);
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @DeviceOpen;
    InOutFunc := @DeviceInOut;
    FlushFunc := @DeviceFlush;
    CloseFunc := @DeviceClose;
  end;
end;


procedure Test;
begin
  AssignHook(Output);

  WriteLn( 'Test ');
end;

Gruß Hagen