debugclient.pas

源代码

unit DebugClient;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Debug info stuff

  $jrsoftware: issrc/Projects/DebugClient.pas,v 1.18 2004/12/23 03:25:48 jr Exp $
}

interface

uses
  Windows, SysUtils, Messages, DebugStruct;

var
  Debugging: Boolean;
  DebugClientCompiledCodeText: String;
  DebugClientCompiledCodeDebugInfo: String;

procedure DebugNotify(Kind: TDebugEntryKind; Index: Integer; var ADebugContinueStepOver: Boolean);
procedure DebugNotifyException(Exception: String; Kind: TDebugEntryKind; Index: Integer);
procedure DebugNotifyIntermediate(Kind: TDebugEntryKind; Index: Integer);
procedure DebugNotifyLogMessage(const Msg: String);
procedure DebugNotifyTempDir(const Dir: String);
procedure DebugNotifyUninstExe(UninstExe: String);
procedure EndDebug;
procedure SetDebugWnd(Wnd: HWND; WantCodeText: Boolean);

implementation

uses
  Forms, CmnFunc2, Main;

type
  TDummyClass = class
  private
    class procedure DebugClientWndProc(var Message: TMessage);
  end;

var
  DebugWnd: HWND;
  DebugClientWnd: HWND;
  DebugContinue: Boolean;
  DebugContinueStepOver: Boolean;

procedure SetDebugWnd(Wnd: HWND; WantCodeText: Boolean);
begin
  Debugging := True;
  DebugWnd := Wnd;
  AttachThreadInput(GetCurrentThreadId, GetWindowThreadProcessId(DebugWnd, nil),
    True);
  DebugClientWnd := AllocateHWnd(TDummyClass.DebugClientWndProc);

  SendMessage(DebugWnd, WM_Debugger_Hello, WPARAM(DebugClientWnd), LPARAM(WantCodeText));
end;

procedure EndDebug;
begin
  Debugging := False;
  if DebugWnd <> 0 then begin
    AttachThreadInput(GetCurrentThreadId, GetWindowThreadProcessId(DebugWnd, nil),
      False);
    SendMessage(DebugWnd, WM_Debugger_Goodbye, 0, 0);
    DebugWnd := 0;
  end;
  if DebugClientWnd <> 0 then begin
    DeallocateHWnd(DebugClientWnd);
    DebugClientWnd := 0;
  end;
end;

procedure InternalDebugNotify(DebuggerMsg: UINT; Kind: TDebugEntryKind; Index: Integer; var ADebugContinueStepOver: Boolean);
var
  SaveAppTitle: String;
  WindowList: Pointer;
  Msg: TMsg;
begin
  ADebugContinueStepOver := False;
  if not Debugging then
    Exit;

  DebugContinue := False;

  if SendMessage(DebugWnd, DebuggerMsg, Ord(Kind), Index) = 0 then begin
    { Don't pause }
    Exit;
  end;

  { Wait until we get clearance to continue }
  SaveAppTitle := Application.Title;
  WindowList := DisableTaskWindows(0);
  try
    Application.Title := '[Paused] ' + SaveAppTitle;
    while not DebugContinue do begin
      case Integer(GetMessage(Msg, 0, 0, 0)) of
        -1: Break; { if GetMessage failed }
        0: begin
             { Repost WM_QUIT messages }
             PostQuitMessage(Msg.WParam);
             Break;
           end;
      end;
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
    ADebugContinueStepOver := DebugContinueStepOver;
  finally
    EnableTaskWindows(WindowList);
    Application.Title := SaveAppTitle;
  end;
  { Bring us back to the foreground }
  Application.BringToFront;
end;

procedure DebugNotify(Kind: TDebugEntryKind; Index: Integer; var ADebugContinueStepOver: Boolean);
begin
  InternalDebugNotify(WM_Debugger_Stepped, Kind, Index, ADebugContinueStepOver);
end;

procedure DebugNotifyIntermediate(Kind: TDebugEntryKind; Index: Integer);
var
  B: Boolean;
begin
  InternalDebugNotify(WM_Debugger_SteppedIntermediate, Kind, Index, B);
end;

procedure DebugNotifyException(Exception: String; Kind: TDebugEntryKind; Index: Integer);
var
  B: Boolean;
begin
  SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_Exception,
    Exception);
  InternalDebugNotify(WM_Debugger_Exception, Kind, Index, B);
end;

procedure DebugNotifyTempDir(const Dir: String);
begin
  SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_TempDir, Dir);
end;

procedure DebugNotifyUninstExe(UninstExe: String);
begin
  SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_UninstExe, UninstExe);
end;

procedure DebugNotifyLogMessage(const Msg: String);
begin
  SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_LogMessage, Msg);
end;

class procedure TDummyClass.DebugClientWndProc(var Message: TMessage);
var
  VariableDebugEntry: TVariableDebugEntry;
  EvaluateExp, EvaluateResult: String;
begin
  try
    case Message.Msg of
      WM_DebugClient_Detach: begin
          Debugging := False;
          DebugWnd := 0;
          { If it's paused, force it to continue }
          DebugContinue := True;
          { Make the GetMessage call in DebugNotify return immediately }
          PostMessage(0, 0, 0, 0);
        end;
      WM_DebugClient_Continue: begin
          DebugContinue := True;
          DebugContinueStepOver := Message.wParam = 1;
          { Make the GetMessage call in DebugNotify return immediately }
          PostMessage(0, 0, 0, 0);
        end;
      WM_COPYDATA: begin
          case TWMCopyData(Message).CopyDataStruct.dwData of
            CD_DebugClient_EvaluateConstant: begin
                try
                  SetString(EvaluateExp, PChar(TWMCopyData(Message).CopyDataStruct.lpData),
                    TWMCopyData(Message).CopyDataStruct.cbData);
                  try
                    ConstReadOnly := True;
                    try
                      EvaluateResult := ExpandConst(EvaluateExp);
                    finally
                      ConstReadOnly := False;
                    end;
                    Message.Result := 1;
                  except
                    EvaluateResult := GetExceptMessage;
                    Message.Result := 2;
                  end;
                  SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_Reply,
                    EvaluateResult);
                except
                  { don't propogate exceptions }
                end;
              end;
            CD_DebugClient_EvaluateVariableEntry: begin
                try
                  Move(TWMCopyData(Message).CopyDataStruct.lpData^, VariableDebugEntry, SizeOf(VariableDebugEntry));
                  try
                    if CodeRunner = nil then
                      raise Exception.Create('Cannot evaluate variable because [Code] isn''t running yet');
                    EvaluateResult := CodeRunner.EvaluateUsedVariable(VariableDebugEntry.Param1,
                      VariableDebugEntry.Param2, VariableDebugEntry.Param3, VariableDebugEntry.Param4);
                    Message.Result := 1;
                  except
                    EvaluateResult := GetExceptMessage;
                    Message.Result := 2;
                  end;
                  SendCopyDataMessageStr(DebugWnd, DebugClientWnd, CD_Debugger_Reply,
                    EvaluateResult);
                except
                  { don't propogate exceptions }
                end;
              end;
            CD_DebugClient_CompiledCodeText: begin
                try
                  DebugClientCompiledCodeText := '';
                  SetString(DebugClientCompiledCodeText, PChar(TWMCopyData(Message).CopyDataStruct.lpData),
                    TWMCopyData(Message).CopyDataStruct.cbData);
                  Message.Result := 1;
                except
                  { don't propogate exceptions }
                end;
              end;
            CD_DebugClient_CompiledCodeDebugInfo: begin
                try
                  DebugClientCompiledCodeDebugInfo := '';
                  SetString(DebugClientCompiledCodeDebugInfo, PChar(TWMCopyData(Message).CopyDataStruct.lpData),
                    TWMCopyData(Message).CopyDataStruct.cbData);
                  Message.Result := 1;
                except
                  { don't propogate exceptions }
                end;
              end;
          end;
        end;
    else
      with Message do
        Result := DefWindowProc(DebugClientWnd, Msg, WParam, LParam);
    end;
  except
    Application.HandleException(nil);
  end
end;

end.