home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / windows / debugter / udebug.pas < prev   
Pascal/Delphi Source File  |  1994-04-01  |  2KB  |  78 lines
  1. { ======================================================================= }
  2. {                                                                         }
  3. { uDebug -  dos-alike debugging help under windows without WinCrt         }
  4. {                                                                         }
  5. { Author: SB                                                              }
  6. { Update: 18.03.94                                                        }
  7. {                                                                         }
  8. { ======================================================================= }
  9.  
  10. unit uDebug;
  11.  
  12. { ======================================================================= }
  13. Interface
  14. { ======================================================================= }
  15.  
  16. uses
  17.   winTypes,
  18.   winProcs,
  19.   winDos,
  20.   Strings;
  21.  
  22. procedure AssignDebug(var F: Text);
  23.  
  24. { ======================================================================= }
  25. Implementation
  26. { ======================================================================= }
  27.  
  28. function dwOutput(var F : TTextRec) : Integer; far;
  29. var
  30.   Tmp             : array[0..255] of char;
  31. begin
  32.   if F.BufPos<>0 then
  33.   begin
  34.     OutputDebugString(StrLCopy(Tmp,PChar(F.BufPtr),F.BufPos));
  35.     F.BufPos:=0;
  36.   end;
  37.   dwOutput:=0;
  38. end;
  39.  
  40. { ----------------------------------------------------------------------- }
  41.  
  42. function dwClose(var F : TTextRec) : Integer; far;
  43. begin
  44.   dwClose:=0;
  45. end;
  46.  
  47. { ----------------------------------------------------------------------- }
  48.  
  49. function dwOpen(var F : TTextRec) : Integer; far;
  50. begin
  51.   F.Mode:=fmOutput;
  52.   F.InOutFunc:=@dwOutput;
  53.   F.FlushFunc:=@dwOutput;
  54.   F.CloseFunc:=@dwClose;
  55.   dwOpen:=0;
  56. end;
  57.  
  58. { ----------------------------------------------------------------------- }
  59.  
  60. procedure AssignDebug(var F: Text);
  61. begin
  62.   with TTextRec(F) do
  63.   begin
  64.     Handle:=$FFFF;
  65.     Mode:=fmClosed;
  66.     BufSize:=SizeOf(Buffer);
  67.     BufPtr:=@Buffer;
  68.     OpenFunc:=@dwOpen;
  69.     Name[0]:=#0;
  70.   end;
  71. end;
  72.  
  73. { ----------------------------------------------------------------------- }
  74.  
  75. begin
  76.   AssignDebug(Output);
  77.   Rewrite(Output);
  78. end.