peldebugit.pas

CVS IDE plugin for Borland Delphi this is a good program,i like this kind of practise

(* $Id: PELDebugit.pas,v 1.6 2002/12/27 16:22:44 turbo Exp $ *)
{$WEAKPACKAGEUNIT ON}
unit PELDebugit;
{$I BORCVS.inc}
interface
uses
  Messages,
  Windows,
  Classes,
  Sysutils;

type
  TDebugMsgEvent = procedure(Sender: TObject; const DebugStr: string) of object;

procedure DebugStr(const DebugMsg: string);
procedure DebugStrF(const s: string; const Args: array of const);
procedure DebugStrPrintable(const DebugMsg: string);
procedure DebugStrBuffer(const Buffer; Count: Integer);

implementation

procedure DebugStr(const DebugMsg: string);
var
  CDS: TCopyDataStruct;
  DbWin: hWnd;
  Name: string;
  Msg: PChar;
  LenStr: Integer;
begin
  DbWin := FindWindow('TDebugWindow', nil);
  if DbWin <> 0 then
  begin
    setlength(name, 255);
    LenStr := GetModuleFileName(HInstance, pchar(name), 255);
    setlength(Name, LenStr);
    LenStr := Length(DebugMsg) + Length(Name) + 2;
    CDS.cbData := LenStr;
    GetMem(Msg, LenStr);
    try
      StrPCopy(Msg, Name + #9 + DebugMsg);
      CDS.lpData := Msg;
      SendMessage(DbWin, WM_COPYDATA, HInstance, LParam(@CDS));
    finally
      FreeMem(Msg, LenStr);
    end;
  end;
end;

procedure DebugStrF(const s: string; const Args: array of const);
var
  dbgstr: string;
begin
  try
    dbgstr := Format(s, Args)
  except
    on E: Exception do
      dbgstr := 'DebugStrF error "' + s + '" ' + E.Message;
  end;
  DebugStr(dbgstr);
end;

procedure DebugStrPrintable(const DebugMsg: string);
var
  s: string;
  i: integer;
  c: char;
  function Hex2(B: Byte): string;
  const
    HexArray: array[0..15] of char = '0123456789ABCDEF';
  begin
    setlength(result, 2);
    Hex2[1] := HexArray[B shr 4];
    Hex2[2] := HexArray[B and $F];
  end;
begin
  s := '';
  for i := 1 to length(DebugMsg) do
  begin
    c := DebugMsg[i];
    case c of
      #32..#127: s := s + c;
      #192..#246: s := s + c;
    else
      s := s + '$' + Hex2(ord(c));
    end;
  end;
  DebugStr(s);
end;

procedure DebugStrBuffer(const Buffer; Count: Integer);
var
  s: string;
begin
  setlength(s, Count);
  move(buffer, s, count);
  DebugStrPrintable(s);
end;

end.