OberonCore

MODULE TestStdToLog;

  IMPORT
    WinApi, Dialog, Strings;

  CONST
    INVALID_HANDLE_VALUE = -1;
    pipeName = "\\.\pipe\stdoutToBBLog";
   
  VAR
    read, write: WinApi.HANDLE;
    ovrl: WinApi.OVERLAPPED;
   
  PROCEDURE ShowWinErr (IN act: ARRAY OF CHAR);
    VAR  msg: ARRAY 512 OF CHAR; err, res: INTEGER;
  BEGIN
    err := WinApi.GetLastError();
    res := WinApi.FormatMessageW(
      WinApi.FORMAT_MESSAGE_FROM_SYSTEM,
      0, err, 0, msg, LEN(msg), NIL
      );
    IF res = 0 THEN  (* Описание ошибки не получено *)
      Strings.IntToString(err, msg); msg := msg + " (WinAPI-код ошибки)"
    END;
    Dialog.ShowParamMsg("Ошибка при ^0: ^1", act, msg, "")
  END ShowWinErr;
 
  PROCEDURE Uninstall;
    VAR  res: INTEGER;
  BEGIN
    IF write # INVALID_HANDLE_VALUE THEN
      res := WinApi.CloseHandle(write);
      write := INVALID_HANDLE_VALUE;
      IF res = 0 THEN ShowWinErr("CloseHandle(write)") END
    END;
    IF read # INVALID_HANDLE_VALUE THEN
      res := WinApi.CloseHandle(read);
      read := INVALID_HANDLE_VALUE;
      IF res = 0 THEN ShowWinErr("CloseHandle(read)") END
    END;
    (* An instance of a named pipe is always deleted when the last handle to the instance of the named pipe is closed. *)
    IF ovrl.hEvent # INVALID_HANDLE_VALUE THEN
      res := WinApi.CloseHandle(ovrl.hEvent);
      ovrl.hEvent := INVALID_HANDLE_VALUE;
      IF res = 0 THEN ShowWinErr("CloseHandle(ovrl.hEvent)") END
    END
  END Uninstall;

  PROCEDURE CreatePipe;
    VAR  res: INTEGER;
  BEGIN
    res := WinApi.CreateNamedPipe(
      pipeName,
      ORD({WinApi.PIPE_ACCESS_INBOUND} + WinApi.FILE_FLAG_OVERLAPPED),
      WinApi.PIPE_TYPE_BYTE + WinApi.PIPE_READMODE_BYTE + WinApi.PIPE_WAIT,
      1,
      1024,  (* ? *)
      1024,  (* ? *)
      1,  (* ? *)
      NIL);
    IF res # INVALID_HANDLE_VALUE THEN
      read := res
    ELSE
      ShowWinErr("CreateNamedPipe")
    END
  END CreatePipe;

  PROCEDURE ConnectPipe;
    VAR  res: INTEGER; ovrl: WinApi.OVERLAPPED;
  BEGIN
    (* If hNamedPipe was opened with FILE_FLAG_OVERLAPPED, the lpOverlapped parameter must not be NULL. It must point to a valid OVERLAPPED structure. If hNamedPipe was opened with FILE_FLAG_OVERLAPPED and lpOverlapped is NULL, the function can incorrectly report that the connect operation is complete.

If hNamedPipe was created with FILE_FLAG_OVERLAPPED and lpOverlapped is not NULL, the OVERLAPPED structure pointed to by lpOverlapped must contain a handle to a manual-reset event object (which the server can create by using the CreateEvent function). *)
    ovrl.hEvent := WinApi.CreateEvent(NIL, WinApi.TRUE, WinApi.FALSE, NIL);
    IF ovrl.hEvent # 0 THEN
      res := WinApi.ConnectNamedPipe(read, ovrl);
      IF res = 0 THEN ShowWinErr("ConnectNamedPipe") END
    ELSE
      ShowWinErr("CreateEvent")
    END
  END ConnectPipe;

  PROCEDURE Install;
    VAR  res: INTEGER;
  BEGIN
    read := INVALID_HANDLE_VALUE; write := INVALID_HANDLE_VALUE;
    CreatePipe;
    IF read # INVALID_HANDLE_VALUE THEN
      ConnectPipe;
     
      res := WinApi.CreateFile(
        pipeName,
        WinApi.GENERIC_WRITE,
        {},
        NIL,
        WinApi.OPEN_EXISTING,  (* ? *)
        WinApi.FILE_ATTRIBUTE_NORMAL,  (* ? *)
        0
        );
     
      IF res = INVALID_HANDLE_VALUE THEN
        ShowWinErr("CreateFile")
      ELSE  (* res # INVALID_HANDLE_VALUE *)
        write := res
      END
    END
  END Install;
 
BEGIN
  Install
CLOSE
  Uninstall
END TestStdToLog.

^Q "Kernel.LoadMod('TestStdToLog')"

MODULE TestStdToLog;

   IMPORT
      WinApi, Dialog, Strings, Log, Services, SYSTEM;

   CONST
      INVALID_HANDLE_VALUE = -1;
   
   TYPE
      Action = POINTER TO RECORD (Services.Action) END;
      
   VAR
      a: Action;
      read, write: WinApi.HANDLE;
   
   PROCEDURE ShowWinErr (IN act: ARRAY OF CHAR);
      VAR   msg: ARRAY 512 OF CHAR; err, res: INTEGER;
   BEGIN
      err := WinApi.GetLastError();
      res := WinApi.FormatMessageW(
         WinApi.FORMAT_MESSAGE_FROM_SYSTEM,
         0, err, 0, msg, LEN(msg), NIL
         );
      IF res = 0 THEN   (* Описание ошибки не получено *)
         Strings.IntToString(err, msg); msg := msg + " (WinAPI-код ошибки)"
      END;
      Dialog.ShowParamMsg("Ошибка при ^0: ^1", act, msg, "")
   END ShowWinErr;

   PROCEDURE WriteChar (c: SHORTCHAR);
   BEGIN
      CASE c OF
      | 09X:   Log.Tab
      | 0AX, 0DX:   Log.Ln
      ELSE
         Log.Char(c)
      END
   END WriteChar;

   PROCEDURE (a: Action) Do;
      VAR   res, avail, n: INTEGER; c: SHORTCHAR;
   BEGIN
      res := WinApi.PeekNamedPipe(read, 0, 0, NIL, avail, NIL);
      (*IF (res = 0) THEN ShowWinErr("PeekNamedPipe") END;*)
      IF (res # 0) & (avail > 0) THEN
         (*Log.Int(avail); Log.Ln;*)
         res := WinApi.ReadFile(read, SYSTEM.ADR(c), 1, n, NIL);
         (*IF (res = 0) THEN ShowWinErr("ReadFile") END;*)
         WHILE (res # 0) & (n = 1) & (avail > 0) DO
            WriteChar(c); DEC(avail);
            IF avail > 0 THEN
               res := WinApi.ReadFile(read, SYSTEM.ADR(c), 1, n, NIL);
               (*IF (res = 0) THEN ShowWinErr("ReadFile") END;*)
            END
         END
      END;
      Services.DoLater(a, Services.Ticks() + Services.resolution)
   END Do;
   
   PROCEDURE Install;
      VAR   res: INTEGER;
   BEGIN
      read := INVALID_HANDLE_VALUE; write := INVALID_HANDLE_VALUE;
      res := WinApi.CreatePipe(read, write, NIL, 0);
      IF res # 0 THEN
         res := WinApi.SetStdHandle(WinApi.STD_OUTPUT_HANDLE, write);
         IF res # 0 THEN
            NEW(a);
            Services.DoLater(a, Services.Ticks() + Services.resolution)
         ELSE
            ShowWinErr("SetStdHandle")
         END
      ELSE
         ShowWinErr("CreatePipe")
      END
   END Install;
   
   PROCEDURE Uninstall;
      VAR   res: INTEGER;
   BEGIN
      IF write # INVALID_HANDLE_VALUE THEN
         res := WinApi.CloseHandle(write); write := INVALID_HANDLE_VALUE;
         IF res = 0 THEN ShowWinErr("CloseHandle(write)") END
      END;
      IF read # INVALID_HANDLE_VALUE THEN
         res := WinApi.CloseHandle(read); read := INVALID_HANDLE_VALUE;
         IF res = 0 THEN ShowWinErr("CloseHandle(read)") END
      END
   END Uninstall;

   PROCEDURE Do*;
      VAR   str: ARRAY 1024 OF SHORTCHAR; res, wr: INTEGER;
   BEGIN
      str := "Тест" + 09X + "Test" + 09X + "***" + 0AX;
      res := WinApi.WriteFile(write, SYSTEM.ADR(str), LEN(str$), wr, NIL);
      IF wr # LEN(str$) THEN ShowWinErr("WriteFile") END
   END Do;

BEGIN
   Install
CLOSE
   Uninstall
END TestStdToLog.

^Q TestStdToLog.Do

   PROCEDURE Install;
...
>>            IF a = NIL THEN NEW(a) END;
            Services.DoLater(a, Services.Ticks() + Services.resolution)

   PROCEDURE Uninstall;
      VAR   res: INTEGER;
   BEGIN
>>      IF a # NIL THEN Services.RemoveAction(a) END;

MODULE TestStdToLogDll ["Project1.dll"];

   PROCEDURE Test*;

END TestStdToLogDll.

MODULE TestTemp;
   
   IMPORT TestStdToLogDll, Log;
   
   PROCEDURE Do*;
   BEGIN
      Log.String("TestStdToLogDll.Test:"); Log.Ln;
      TestStdToLogDll.Test
   END Do;

END TestTemp.

"Kernel.LoadMod('TestStdToLog')"
TestTemp.Do
DevDebug.UnloadThis TestStdToLog

(* Delphi dll *)
library Project1;

uses
  SysUtils,
  Classes;

{$R *.res}

procedure Test;
begin
  writeln('x'#9'='#9, 1);
end;

exports Test;

begin
end.