Win32.WinTrace.Mod 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120
  1. MODULE WinTrace;
  2. IMPORT Kernel32, Modules,Trace,Commands;
  3. CONST
  4. none = 0; console = 1; file = 2;
  5. VAR
  6. hin-, hout-, herr-: Kernel32.HANDLE;
  7. mode: LONGINT; (* none, console or file *)
  8. (* Sender to be used with Stream.Writer *)
  9. PROCEDURE Send* (CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT);
  10. VAR b: Kernel32.BOOL;
  11. BEGIN
  12. IF mode # none THEN
  13. b := Kernel32.WriteFile (hout, buf[ofs], len, len, NIL);
  14. Kernel32.FlushFileBuffers(hout);
  15. END;
  16. END Send;
  17. (* Sender to be used with Stream.Writer *)
  18. PROCEDURE SendError* (CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT);
  19. VAR b: Kernel32.BOOL;
  20. BEGIN
  21. IF mode # none THEN
  22. b := Kernel32.WriteFile (herr, buf[ofs], len, len, NIL);
  23. Kernel32.FlushFileBuffers(herr);
  24. END;
  25. END SendError;
  26. (* Receiver to be used with Stream.Reader *)
  27. PROCEDURE Receive* (VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT);
  28. VAR b: Kernel32.BOOL; tlen: LONGINT;
  29. BEGIN
  30. len := 0;
  31. b := Kernel32.ReadFile (hin, buf[ofs], size, len, NIL);
  32. DEC(size, len);
  33. WHILE (len < min) DO
  34. b := Kernel32.ReadFile (hin, buf[ofs], size, tlen, NIL);
  35. INC(len, tlen);
  36. DEC(size, tlen);
  37. END;
  38. res := 0;
  39. END Receive;
  40. PROCEDURE Init;
  41. BEGIN
  42. mode := none;
  43. END Init;
  44. PROCEDURE Close*;
  45. VAR res: LONGINT;
  46. BEGIN
  47. IF mode = console THEN
  48. Kernel32.CloseHandle(hout);
  49. res := Kernel32.FreeConsole ();
  50. ELSIF mode = file THEN
  51. Kernel32.CloseHandle(hout);
  52. END;
  53. hout := Kernel32.InvalidHandleValue;
  54. mode := none;
  55. END Close;
  56. PROCEDURE OpenConsole*;
  57. VAR res: LONGINT;
  58. BEGIN
  59. IF mode = console THEN RETURN
  60. ELSIF mode = file THEN Close
  61. END;
  62. IF Kernel32.AttachConsole(-1) = Kernel32.False THEN
  63. res := Kernel32.AllocConsole ();
  64. END;
  65. hin := Kernel32.GetStdHandle (Kernel32.STDInput);
  66. ASSERT ((hin) # (Kernel32.InvalidHandleValue));
  67. hout := Kernel32.GetStdHandle (Kernel32.STDOutput);
  68. ASSERT ((hout) # (Kernel32.InvalidHandleValue));
  69. herr := Kernel32.GetStdHandle (Kernel32.STDError);
  70. ASSERT ((herr) # (Kernel32.InvalidHandleValue));
  71. Trace.Char := Char;
  72. mode := console;
  73. END OpenConsole;
  74. PROCEDURE OpenFile*(context: Commands.Context);
  75. VAR filename: ARRAY 256 OF CHAR;
  76. BEGIN
  77. Close;
  78. IF ~context.arg.GetString(filename) THEN filename := "WinTrace.Text" END;
  79. hout := Kernel32.CreateFile(filename, {Kernel32.GenericWrite}, {Kernel32.FileShareRead}, NIL, Kernel32.CreateAlways, {Kernel32.FileAttributeNormal}, Kernel32.NULL);
  80. ASSERT ((hout) # (Kernel32.InvalidHandleValue));
  81. herr := hout;
  82. Trace.Char := Char;
  83. mode := file;
  84. END OpenFile;
  85. PROCEDURE Terminate;
  86. BEGIN
  87. Close;
  88. END Terminate;
  89. PROCEDURE Char(c: CHAR);
  90. VAR len: LONGINT; b: Kernel32.BOOL;
  91. BEGIN
  92. len := 1;
  93. b := Kernel32.WriteFile(hout,c,len,len,NIL);
  94. END Char;
  95. BEGIN
  96. Init;
  97. Modules.InstallTermHandler (Terminate);
  98. END WinTrace.
  99. WinTrace.OpenFile ~
  100. WinTrace.OpenFile myTrace.Text ~
  101. WinTrace.OpenConsole
  102. WinTrace.Close