bndebug.pas

Delphi专用调试器bannico的源代码

{
Delphi 代码调试工具

类似Raize CodeSite的一个工具，利用程序间通讯的方法实现调试信息传递。
程序仅仅实现了一些简单的功能，代码接收框用TRichEdit是为以后接收图片信息提供一
个扩展的基础。感兴趣可以自己扩展功能。

本代码不保留版权，可自由使用。
转载请保留出处及本说明。


Bannico

E_Mail:[e-mail]

2006年11月24日 上海
}
unit bnDebug;

interface

uses
  SysUtils, Classes, Windows, Messages, Forms, Graphics, Registry ,ShellAPI;

const
  DebugHandle = 'Delphi代码调试工具';
  SoftKey = 'SOFTWARE\BNCDebug';
  Flage = '——>';
type
  TDebug = class (TComponent)
  private
    FormPath:String;
    
    procedure SendData(Msg:string);
  protected
    Reg:TRegistry;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;
    procedure BeginSend;
    procedure EndSend;
    procedure Send(Msg:String;Value:Char);overload;
    procedure Send(Msg:String;Value:PAnsiChar);overload;
    procedure Send(Msg:String;Value:String);overload;
    procedure Send(Msg:String;Value:TStrings);overload;
    procedure Send(Msg:String;Value:Integer);overload;
    procedure Send(Msg:String;Value:Extended);overload;
    procedure Send(Msg:String;Value:Word);overload;
    procedure Send(Msg:String;Value:Boolean);overload;
    procedure Send(Msg:String;Value:TPoint);overload;
    procedure Send(Msg:String;Value:TRect);overload;
    procedure Send(Msg:String;Value:TBitmap);overload;
  published

  end;
  procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Debug',[TDebug]);
end;

constructor TDebug.Create(AOwner: TComponent);
Var
  Handle:THandle;
begin
  inherited Create(AOwner);
  FormPath:='';
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;

  if Reg.OpenKey(SoftKey,False) then
  begin
    FormPath:=Reg.ReadString('FormPath');
  end;
  Reg.Free;
end;

destructor TDebug.Destroy;
begin
  inherited;

end;

procedure TDebug.SendData(Msg:string);
var
  CDS: TCopyDataStruct;
  Handle: THandle;
begin
  Msg:='    '+Msg;
  CDS.cbData := Length (Msg) + 1;
  GetMem (CDS.lpData, CDS.cbData );
  StrCopy (CDS.lpData, PChar (Msg));

  Handle := FindWindow (nil, DebugHandle);
  if Handle<0 then
    ShellExecute(handle,'open','FormPath',nil,nil,SW_ShowNormal)
  else
    SendMessage (Handle, WM_COPYDATA, Handle,Cardinal(@CDS));

  FreeMem (CDS.lpData);
end;

{*********************Send**********************}

procedure TDebug.BeginSend;
begin
  SendData(DateTimeToStr(Now));
  SendData('===================Begin===================');
end;

procedure TDebug.EndSend;
begin
  SendData('===================E n d===================');
end;

procedure TDebug.Send(Msg:String;Value:Char);
begin
  SendData(Msg+Flage+Value);
end;

procedure TDebug.Send(Msg:String;Value:PAnsiChar);
begin
  SendData(Msg+Flage+Value);
end;

procedure TDebug.Send(Msg:String;Value:string);
begin
  SendData(Msg+Flage+Value);
end;

procedure TDebug.Send(Msg:String;Value:TStrings);
begin
  SendData(Msg+Flage+Value.Text);
end;

procedure TDebug.Send(Msg:String;Value:Integer);
begin
  SendData(Msg+Flage+IntToStr(Value));
end;

procedure TDebug.Send(Msg:String;Value:Extended);
begin
  SendData(Msg+Flage+FloatToStr(Value));
end;

procedure TDebug.Send(Msg:String;Value:Word);
begin
  SendData(Msg+Flage+FloatToStr(Value));
end;

procedure TDebug.Send(Msg:String;Value:Boolean);
var
  S:String;
begin
  case Value of
  True:
    SendData(Msg+Flage+'True');
  False:
    SendData(Msg+Flage+'False');
  end;
end;

procedure TDebug.Send(Msg:String;Value:TPoint);
begin
  SendData(Msg+Flage+'X:'+IntToStr(Value.X)+'   Y:'+IntToStr(Value.Y));
end;

procedure TDebug.Send(Msg:String;Value:TRect);
begin
  SendData(Msg+Flage+
           'Left:'+IntToStr(Value.Left)+
           '  Top:'+IntToStr(Value.Top)+
           '  Right:'+IntToStr(Value.Right)+
           '  Botton:'+IntToStr(Value.Bottom));
end;

procedure TDebug.Send(Msg:String;Value:TBitmap);
begin

end;

end.