unit GX_MSDNLookup;

{$I GX_CondDefine.inc}

(*
 Look up current token in MSDN (local or online).

 Original author: Primoz Gabrijelcic <gabr@17slon.com>
 Creation date  : 2000-11-04
 Last change    : 2000-11-07
 Version        : 1.01

 Tested with: Delphi 5 and MSDN Library January 2000 on Windows 2000.

 Thanks to Miha Remec for help and suggestions.

 Operation:
   - Click somewhere inside token (PeekMessage, RegOpenKeyEx...).
   - Run expert.
   - If set in configuration, expert will prompt you for token and lookup target
     (internet, local copy), then will open default browser or local MSDN
     installation (as selected by user or as specified in configuration) on
     selected token.

 Change history :
   1.01: 2000-11-07
   - Added buttons "Restore default URL" and "Search for MSDN Library" to
     configuration dialog.
   - Made configuration dialog non-sizable.
   - Incorporated changes suggested by Miha Remec to simplify communication with
     local MSDN Library and made it more roboust.
   - Local search can be now executed in Index or Search page.
   - Added prompt options: on empty token, never, always; and prompt dialog.
   - Safer detection of installed MSDN Library (thanks to Miha Remec).

   1.0: 2000-11-06
   - First released version - both internet and local lookup are working.
   
   0.1: 2000-11-04
   - First beta version - internet lookup is working, local not yet.
*)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, DsgnIntf, ToolIntf, ExptIntf, RplWizInfo, EditIntf,
  GX_Experts, ExtCtrls;

type
  TfmMSDNLookup = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    grpLookup: TGroupBox;
    rbUseInternet: TRadioButton;
    rbUseLocalCopy: TRadioButton;
    lblSearchURL: TLabel;
    lblCommandLine: TLabel;
    inpSearchUrl: TEdit;
    inpCommandLine: TEdit;
    lblStartIn: TLabel;
    inpStartIn: TEdit;
    btnResetDefaultURL: TButton;
    btnSearchForMSDN: TButton;
    lblSearchOn: TLabel;
    grpSearchOn: TGroupBox;
    rbSearchInIndex: TRadioButton;
    rbSearchInSearch: TRadioButton;
    grpPrompt: TGroupBox;
    lblShowPrompt: TLabel;
    inpShowPrompt: TComboBox;
    procedure btnResetDefaultURLClick(Sender: TObject);
    procedure btnSearchForMSDNClick(Sender: TObject);
  private
    FOnResetDefaultURL: TNotifyEvent;
    FOnSearchForMSDN: TNotifyEvent;
  public
    property OnResetDefaultURL: TNotifyEvent read FOnResetDefaultURL write FOnResetDefaultURL;
    property OnSearchForMSDN: TNotifyEvent read FOnSearchForMSDN write FOnSearchForMSDN;
  end;

  TMSDNShowPrompt = (showOnEmptyToken,showNever,showAlways);

  TMSDNLookupExpert = class(TGX_EnhExpert)
  protected
    procedure SetActive(New: Boolean); override;
  private
    FUseLocalCopy: boolean;
    FUseInternet: boolean;
    FInternetCommand: string;
    FLocalCommand: string;
    FLocalFolder: string;
    FSearchInIndex: boolean;
    FShowPrompt: TMSDNShowPrompt;
    procedure DoMSDNLookup;
    function GetCurrentToken(var token: string): boolean;
    procedure GuessMSDNLocation(var MSDNCommandLine, MSDNFolder: string);
    procedure LookupCurrentToken(token: string);
    procedure SetDefaults;
    function PromptUserOptions(var defUseInternet,defSearchInIndex: boolean;
      var defToken: string): boolean;
    procedure DoResetDefaultURL(sender: TObject);
    procedure DoSearchForMSDN(sender: TObject);
  public
    constructor Create; override;
    procedure Click(Sender: TObject); override;
    procedure Configure; override;
    function GetDisplayName: string; override;
    function GetMenuCaption: string; override;
    function GetMenuMask: string; override;
    function GetMenuName: string; override;
    function GetName: string; override;
    function IconFileName: string; override;
    procedure LoadSettings; override;
    procedure SaveSettings; override;
  end;

implementation

{$R *.DFM}

uses
{$IFOPT D+}
  GX_DbugIntf,
{$ENDIF D+}
  GX_ConfigurationInfo, GX_GExperts, GX_GenFunc, GX_MessageBox, GX_EditReader,
  ExpertUtil,
  Clipbrd, Registry, ShellAPI, CommCtrl,
  GX_MSDNLookup_Prompt;

const
  CTokenTag = '%TOKEN%';
  CWaitOnMSDNToStart = 30; // seconds
  CDefaultMSDNURL = // copied from browser
    'http://search.microsoft.com/us/dev/default.asp?so=RECCNT&'+
    'qu='+CTokenTag+'&'+
    'btnSearch=Search&boolean=ALL&chkM=on&chkM_0=on&chkM_1=on&chkM_3=on&'+
    'chkM_4=on&chkM_5=on&chkM_7=on&chkM_9=on&chkM_10=on&chkM_11=on&chkM_12=on&'+
    'chkM_13=on&chkM_14=on&chkM_15=on&chkM_17=on&chkM_18=on&chkS=on&chkS_0=on&'+
    'chkS_1=on&chkS_2=on&chkS_3=on&chkS_4=on&chkS_5=on&chkS_6=on&chkS_7=on&'+
    'chkS_8=on&chkS_9=on&chkS_10=on&chkS_11=on&chkS_12=on&chkS_13=on&'+
    'chkS_14=on&chkS_15=on&chkA_0=on&chkA_1=on&chkA_2=on&chkA_3=on&chkA_4=on&'+
    'chkA_5=on&chkA_6=on&chkP_0=on&chkP_1=on&chkP_2=on&chkP_4=on&chkP_5=on&'+
    'chkP_6=on&chkP_9=on&chkP_11=on&chkP_12=on&chkP_13=on&chkP_14=on&'+
    'chkP_16=on&chkK=on&p=1&nq=NEW';

type
  TBetterRegistry = class(TRegistry)
  {$IFNDEF GX_VER125_up}
    function OpenKeyReadOnly(const Key: string): Boolean;
  {$ENDIF GX_VER125_up}
  end;

  TLookupEngine = class
  private
    hMSDN: HWND;
    hMSDNSysTab: HWND;
    hMSDNEdit: HWND;
    function ActivateTab(tabIndex: integer): boolean;
    function Elapsed(start: int64; timeout: cardinal): boolean;
    function GetMSDNHandle: HWND;
    function LocateMSDNWindows(searchInIndex, waitForStart: boolean): boolean;
    procedure SplitCommand(cmd: string; var progName, progParam: string);
    procedure StartMSDNSearch(token: string);
  public
    procedure LookupTokenOnInternet(token: string; url: string);
    procedure LookupTokenLocal(token: string; msdnCommand, msdnFolder: string;
      searchInIndex: boolean);
  end;

const
  Hex_Chars: array [0..15] of char = '0123456789ABCDEF';

function HexStr (var num; byteCount : byte): string;
var
  cast : array [1..256] of byte absolute num;
  i,b  : integer;
  res  : string;
begin
  res := '';
  for i := byteCount downto 1 do begin
    b := cast[i] div 16;
    if b >= 16 then b := 0;
    res := res + Hex_Chars[b];
    b := cast[i] mod 16;
    if b >= 16 then b := 0;
    res := res + Hex_Chars[b];
  end;
  SetLength (res, 2*byteCount);
  HexStr := res;
end; { HexStr }

function Escape(s: string): string;
var
  i: integer;
begin
  Result := '';
  for i := 1 to Length(s) do begin
    if s[i] in ['0'..'9','A'..'Z','a'..'z'] then
      Result := Result + s[i]
    else if s[i] = ' ' then
      Result := Result + '+'
    else
      Result := Result + '%' + HexStr(s[i],1);
  end; //for
end; { Escape }

function GetClassNameStr(hwnd: THandle): string;
var
  winClass: array[0..255] of char;
begin
  if GetClassName(hwnd, winClass, 255) <> 0
    then Result := winClass
  else Result := '';
end; { GetClassNameStr }
  
function GetWindowTextStr(hwnd: THandle): string;
var
  winText: array[0..255] of char;
begin
  if GetWindowText(hwnd, winText, 255) <> 0
    then Result := winText
  else Result := '';
end; { GetWindowTextStr }

function ForceForegroundWindow(hwnd: THandle): boolean;
const
  SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
  SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
  ForegroundThreadID: DWORD;
  ThisThreadID      : DWORD;
  timeout           : DWORD;
begin
  if IsIconic(hwnd) then ShowWindow(hwnd, SW_RESTORE);

  if GetForegroundWindow = hwnd then Result := true
  else begin

    // Windows 98/2000 doesn't want to foreground a window when some other
    // window has keyboard focus
  
    if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
      ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
      ((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)))) then
    begin

      // Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
      // Converted to Delphi by Ray Lischner
      // Published in The Delphi Magazine 55, page 16
  
      Result := false;
      ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow,nil);
      ThisThreadID := GetWindowThreadPRocessId(hwnd,nil);
      if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then begin
        BringWindowToTop(hwnd); //IE 5.5 related hack
        SetForegroundWindow(hwnd);
        AttachThreadInput(ThisThreadID, ForegroundThreadID, false);
        Result := (GetForegroundWindow = hwnd);
      end;
      if not Result then begin

        // Code by Daniel P. Stasinski <dannys@karemor.com>

        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0), SPIF_SENDCHANGE);
        BringWindowToTop(hwnd); //IE 5.5 related hack
        SetForegroundWindow(hWnd);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
      end;
    end
    else begin
      BringWindowToTop(hwnd); //IE 5.5 related hack        
      SetForegroundWindow(hwnd);
    end;
      
    Result := (GetForegroundWindow = hwnd);
  end;
end; { ForceForegroundWindow }

{ TfmMSDNLookup }

procedure TfmMSDNLookup.btnResetDefaultURLClick(Sender: TObject);
begin
  if assigned(FOnResetDefaultURL) then
    FOnResetDefaultURL(Self);
end;

procedure TfmMSDNLookup.btnSearchForMSDNClick(Sender: TObject);
begin
  if assigned(FOnSearchForMSDN) then
    FOnSearchForMSDN(Self);
end;

{ TBetterRegistry }

{$IFNDEF GX_VER125_up}
  function IsRelative(const Value: string): boolean;
  begin
    Result := not ((Value <> '') and (Value[1] = '\'));
  end;

  function TBetterRegistry.OpenKeyReadOnly(const Key: string): boolean;
  var
    TempKey : HKey;
    S       : string;
    Relative: boolean;
  begin
    S := Key;
    Relative := IsRelative(S);
    if not Relative then
      Delete(S, 1, 1);
    TempKey := 0;
    Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
        KEY_READ, TempKey) = ERROR_SUCCESS;
    if Result then begin
      if (CurrentKey <> 0) and Relative then
        S := CurrentPath + '\' + S;
      ChangeKey(TempKey, S);
    end;
  end; { TBetterRegistry.OpenKeyReadOnly }
{$ENDIF GX_VER125_up}

{ TMSDNLookupExpert }

procedure TMSDNLookupExpert.Click(Sender: TObject);
begin
  DoMSDNLookup;
end;

procedure TMSDNLookupExpert.Configure;
var
  Dlg: TfmMSDNLookup;
begin
  Dlg := TfmMSDNLookup.Create(nil);
  try
    Dlg.rbUseInternet.Checked := FUseInternet;
    Dlg.rbUseLocalCopy.Checked := FUseLocalCopy;
    Dlg.inpSearchUrl.Text := FInternetCommand;
    Dlg.inpCommandLine.Text := FLocalCommand;
    Dlg.inpStartIn.Text := FLocalFolder;
    Dlg.rbSearchInIndex.Checked := FSearchInIndex;
    Dlg.rbSearchInSearch.Checked := not Dlg.rbSearchInIndex.Checked;
    Dlg.inpShowPrompt.ItemIndex := Ord(FShowPrompt);
    Dlg.OnResetDefaultURL := DoResetDefaultURL;
    Dlg.OnSearchForMSDN := DoSearchForMSDN; 
    if Dlg.ShowModal = mrOK then begin
      FUseInternet := Dlg.rbUseInternet.Checked;
      FUseLocalCopy := Dlg.rbUseLocalCopy.Checked;
      FInternetCommand := Dlg.inpSearchUrl.Text;
      FLocalCommand := Dlg.inpCommandLine.Text;
      FLocalFolder := Dlg.inpStartIn.Text;
      FSearchInIndex := Dlg.rbSearchInIndex.Checked;
      FShowPrompt := TMSDNShowPrompt(Dlg.inpShowPrompt.ItemIndex);
      SaveSettings;
    end;
  finally Dlg.Free; end;
end;

constructor TMSDNLookupExpert.Create;
begin
  inherited Create;
  HasConfigOptions := True;
  HasMenuItem := True;
  {$IFDEF GX_BCB}
  // Default to inactive for BCB until we correctly support it
  DefaultActive := False;
  {$ENDIF GX_BCB}
end;

procedure TMSDNLookupExpert.DoMSDNLookup;
var
  token: string;
begin
  if not GetCurrentToken(token) then
    token := '';
  {$IFOPT D+} SendDebugEx('MSDN Lookup token: >'+token+'<', mtInformation); {$ENDIF}
  LookupCurrentToken(token);
end;

procedure TMSDNLookupExpert.DoResetDefaultURL(sender: TObject);
begin
  (sender as TfmMSDNLookup).inpSearchUrl.Text := CDefaultMSDNURL;
end;

procedure TMSDNLookupExpert.DoSearchForMSDN(sender: TObject);
var
  commandLine: string;
  folder: string;
begin
  GuessMSDNLocation(commandLine,folder);
  (sender as TfmMSDNLookup).inpCommandLine.Text := commandLine;
  (sender as TfmMSDNLookup).inpStartIn.Text := folder;
end;

function TMSDNLookupExpert.GetCurrentToken(var token: string): boolean;
resourcestring
  SCouldNotGetSourceBuffer = 'Could not get source code from editor buffer (is a special selection active?).';
var
  EditRead: TEditReader;
  MemStream: TStringStream;
  ModIntf: TIModuleInterface;
  EditorLine: string;
  FileName: string;
  ScanPos: Integer;
begin
  Result := false;
  token := '';
  MemStream := TStringStream.Create('');
  try
    FileName := ToolServices.GetCurrentFile;

    // Check if we can access module interface. If not, reader cannot be created
    // and there is no way to get a current token.
    ModIntf := ToolServices.GetModuleInterface(FileName);
    if ModIntf <> nil then begin
      ModIntf.Free;
      ModIntf := nil;

      // Since this edit reader is destroyed almost
      // immediately, do not call FreeFileData.
      EditRead := TEditReader.Create(FileName);
      try
        // Search left for first non-alpha char - token will always start with
        // alphabetic character.
        EditorLine := EditRead.GetPrecedingCharacters(256);
        ScanPos := Length(EditorLine);
        while ScanPos > 0 do begin
          if not (EditorLine[ScanPos] in ['a'..'z','A'..'Z','0'..'9','_']) then
            Break;
          Dec(ScanPos);
        end;

        Delete(EditorLine, 1, ScanPos);
        ScanPos := Length(EditorLine);
        EditRead.SaveToStreamFromPos(MemStream);
        MemStream.Position := 0;
        EditorLine := EditorLine + MemStream.ReadString(256);

        if EditorLine <> '' then begin
          if ScanPos = 0 then // nothing was found before cursor so check the current char
            if EditorLine[1] in ['a'..'z','A'..'Z'] then
              ScanPos := 1;

          if ScanPos > 0 then begin
            while ScanPos <= Length(EditorLine) do
            begin
              if not (EditorLine[ScanPos] in ['a'..'z','A'..'Z','0'..'9','_']) then
                Break;
              Inc(ScanPos);
            end;
            Delete(EditorLine,ScanPos,Length(EditorLine)-ScanPos+1);
            token := EditorLine;
            Result := true;
          end;
        end;
      finally EditRead.Free; end;
    end;
  finally MemStream.Free; end;
end;

function TMSDNLookupExpert.GetDisplayName: string;
resourcestring
  SDisplayName = 'MSDN Lookup';
begin
  Result := SDisplayName;
end;

function TMSDNLookupExpert.GetMenuCaption: string;
resourcestring
  SMenuCaption = 'MSDN &Lookup';
begin
  Result := SMenuCaption;
end;

function TMSDNLookupExpert.GetMenuMask: string;
begin
  Result := '';
end;

function TMSDNLookupExpert.GetMenuName: string;
begin
  Result := 'GX_MSDNLookup';
end;

function TMSDNLookupExpert.GetName: string;
begin
  Result := 'MSDNLookup';
end;

procedure TMSDNLookupExpert.GuessMSDNLocation(var MSDNCommandLine,
  MSDNFolder: string);

  function GetMSDNFolder(var msdnFile: string): string;

    function Quote(s: string): string;
    begin
      if (Pos(' ',s) > 0) and (s[1] <> '"') then
        Result := '"' + s + '"'
      else
        Result := s;
    end;

  const
    CMSDNRegBase = '\SOFTWARE\Microsoft\HTML Help Collections\Developer Collections\0x0409';
  var
    reg: TBetterRegistry;
    keys: TStringList;
    iKey: integer;
  begin
    msdnFile := '';
    Result := '';

    // From MSDN article "HOWTO: Troubleshooting MSDN Library
    // Run-Time/Install/Uninstall Problems":
    //[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\HTML Help Collections\Developer Collections\0x0409\0x038498ee0]
    //"Filename"="g:\\Programs\\Microsoft Visual Studio\\MSDN\\2000JAN\\1033\\MSDN000.COL"
    //@="MSDN Library - January 2000"
    //"Full"=dword:00000001

    reg := TBetterRegistry.Create;
    try
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if reg.OpenKeyReadonly(CMSDNRegBase) then begin
        keys := TStringList.Create;
        try
          reg.GetKeyNames(keys);
          for iKey := 0 to keys.Count-1 do begin
            if reg.OpenKeyReadonly(CMSDNRegBase+'\'+keys[iKey]) then begin
              try
                // Check if this is really a MSDN library key
                if Pos('MSDN LIBRARY',UpperCase(reg.ReadString(''))) > 0 then begin
                  msdnFile := Quote(reg.ReadString('Filename'));
                  Result := Quote(ExtractFilePath(msdnFile));
                  break; //for
                end;
              finally reg.CloseKey; end;
            end;
          end;
        finally keys.Free; end;
        reg.CloseKey;
      end;
    finally reg.Free; end;
  end;

  function GetHHProgram: string;
  var
    reg: TBetterRegistry;
  begin
    // HH is usually associated with .chm files
    Result := '';
    reg := TBetterRegistry.Create;
    try
      reg.RootKey := HKEY_CLASSES_ROOT;
      if reg.OpenKeyReadonly('chm.file\shell\open\command') then begin
        Result := reg.ReadString('');
        reg.CloseKey;
      end;
    finally reg.Free; end;
  end;

  function Combine(hhProgram, msdnFile: string): string;
  var
    p: integer;
  begin
    // If there is '%1' in hhProgram, replace it with msdnFile.
    // If not, just append msdnFile.
    p := Pos('%1',hhProgram);
    if p > 0 then begin
      Result := hhProgram;
      Delete(Result,p,2);
      Insert(msdnFile,Result,p);
    end
    else
      Result := hhProgram + ' ' + msdnFile;
  end;

var
  HHProgram: string;
  folder: string;
  msdnFile: string;
begin
  // built from various registry entries
  folder := GetMSDNFolder(msdnFile);
  HHProgram  := GetHHProgram;
  if (folder <> '') and (msdnFile <> '') and (HHProgram <> '') then begin
    MSDNFolder := folder;
    MSDNCommandLine := Combine(HHProgram,msdnFile);
  end
  else begin
    MSDNFolder := '';
    MSDNCommandLine := '';
  end;
end;

function TMSDNLookupExpert.IconFileName: string;
begin
  Result := 'MSDNLookup';
end;

procedure TMSDNLookupExpert.LoadSettings;
var
  RegIni: TRegIniFile;
  useWhat: integer;
  prompt: integer;
begin
  inherited LoadSettings;
  // do not localize any of the below items
  RegIni := TRegIniFile.Create(ConfigInfo.RegKey + '\GExperts');
  try
    // 0 = not set yet, 1 = use internet, 2 = use local, other = illegal (use internet)
    useWhat := RegIni.ReadInteger('MSDNLookup','UseWhat',0);
    if useWhat = 0 then
      SetDefaults
    else begin
      FUseLocalCopy := (useWhat = 2);
      FUseInternet := not FUseLocalCopy;
      FInternetCommand := RegIni.ReadString('MSDNLookup','InternetCommand','');
      FLocalCommand := RegIni.ReadString('MSDNLookup','LocalCommand','');
      FLocalFolder := RegIni.ReadString('MSDNLookup','LocalFolder','');
      FSearchInIndex := RegIni.ReadBool('MSDNLookup','LocalSearchInIndex',true);
      prompt := RegIni.ReadInteger('MSDNLookup','ShowPrompt',0);
      if (prompt < Ord(Low(TMSDNShowPrompt))) or
         (prompt > Ord(High(TMSDNShowPrompt))) then
        prompt := Ord(Low(TMSDNShowPrompt));
      FShowPrompt := TMSDNShowPrompt(prompt);
    end;
  finally
    RegIni.Free;
  end;
end;

procedure TMSDNLookupExpert.LookupCurrentToken(token: string);
var
  engine: TLookupEngine;
  defUseInternet: boolean;
  defSearchInIndex: boolean;
  defToken: string;
begin
  defUseInternet := FUseInternet;
  defSearchInIndex := FSearchInIndex;
  defToken := token;
  if (FShowPrompt = showAlways) or
     ((FShowPrompt = showOnEmptyToken) and (defToken = '')) then
    if not PromptUserOptions(defUseInternet,defSearchInIndex,defToken) then
      Exit;
  if defToken = '' then
    Exit;
  engine := TLookupEngine.Create;
  try
    if defUseInternet then
      engine.LookupTokenOnInternet(defToken,FInternetCommand)
    else
      engine.LookupTokenLocal(defToken,FLocalCommand,FLocalFolder,defSearchInIndex);
  finally engine.Free; end;
end;

function TMSDNLookupExpert.PromptUserOptions(var defUseInternet,
  defSearchInIndex: boolean; var defToken: string): boolean;
var
  Dlg: TfmMSDNLookupPrompt;
begin
  Dlg := TfmMSDNLookupPrompt.Create(nil);
  try
    Dlg.inpToken.Text := defToken;
    Dlg.rbUseInternet.Checked := defUseInternet;
    Dlg.rbUseLocalCopy.Checked := not Dlg.rbUseInternet.Checked;
    Dlg.rbSearchInIndex.Checked := defSearchInIndex;
    Dlg.rbSearchInSearch.Checked := not Dlg.rbSearchInIndex.Checked;
    Dlg.rbUseInternet.Enabled := (FInternetCommand <> '');
    Dlg.rbUseLocalCopy.Enabled := (FLocalCommand <> '');
    Dlg.Prepare;
    if Dlg.ShowModal = mrOK then begin
      defToken := Dlg.InpToken.Text;
      defUseInternet := Dlg.rbUseInternet.Checked;
      defSearchInIndex := Dlg.rbSearchInIndex.Checked;
      Result := true;
    end
    else
      Result := false;
  finally Dlg.Free; end;
end;

procedure TMSDNLookupExpert.SaveSettings;
var
  RegIni: TRegIniFile;
  useWhat: integer;
begin
  inherited SaveSettings;
  // do not localize any of the below items
  RegIni := TRegIniFile.Create(ConfigInfo.RegKey + '\GExperts');
  try
    if FUseInternet then
      useWhat := 1
    else
      useWhat := 2;
    RegIni.WriteInteger('MSDNLookup','UseWhat',useWhat);
    RegIni.WriteString('MSDNLookup','InternetCommand',FInternetCommand);
    RegIni.WriteString('MSDNLookup','LocalCommand',FLocalCommand);
    RegIni.WriteString('MSDNLookup','LocalFolder',FLocalFolder);
    RegIni.WriteBool('MSDNLookup','LocalSearchInIndex',FSearchInIndex);
    RegIni.WriteInteger('MSDNLookup','ShowPrompt',Ord(FShowPrompt));
  finally
    RegIni.Free;
  end;
end;

procedure TMSDNLookupExpert.SetActive(New: Boolean);
begin
  if New <> Active then
  begin
    inherited SetActive(New);
    if New then
      // Nothing to initialize here
    else
    begin
      // Nothing to free here
    end;
  end;
end;

procedure TMSDNLookupExpert.SetDefaults;
begin
  FInternetCommand := CDefaultMSDNURL;
  GuessMSDNLocation(FLocalCommand,FLocalFolder);
  FUseLocalCopy := (FLocalFolder <> '') and (FLocalCommand <> '');
  FUseInternet := not FUseLocalCopy;
  // Save defaults so we don't have to do all this mess at every Delphi startup
  SaveSettings;
end;

{ TLookupEngine }

function TLookupEngine.ActivateTab(tabIndex: integer): boolean;
var
  cnt: integer;
  curTab: integer;
begin
  // Magic: activate Search tab in a very weird manner - by sending left and
  // right arrow keys to the tab control. TCM_SETCURSEL is not useful as it does
  // not trigger TCN_SELCHANGING and HH doesn't update the controls. Under
  // Windows 2000 we cannot fake TCN_SELCHANGING and so are forced to simulate
  // keystrokes.

  cnt := 0; // watchdog counter - there are only four tabs in hMSDNSysTab
  while cnt < 5 do begin
    curTab := SendMessage(hMSDNSysTab, TCM_GETCURSEL, 0, 0);
    if curTab = tabIndex then
      break // while
    else if curTab < tabIndex then begin
      SendMessage(hMSDNSysTab,WM_KEYDOWN,VK_RIGHT,0);
      SendMessage(hMSDNSysTab,WM_KEYUP,VK_RIGHT,0);
    end
    else {cutTab > tabIndex} begin
      SendMessage(hMSDNSysTab,WM_KEYDOWN,VK_LEFT,0);
      SendMessage(hMSDNSysTab,WM_KEYUP,VK_LEFT,0);
    end;
    Inc(cnt);
  end;
  curTab := SendMessage(hMSDNSysTab, TCM_GETCURSEL, 0, 0);
  Result := (curTab = tabIndex);
end;

function TLookupEngine.Elapsed(start: int64; timeout: cardinal): boolean;
var
  stop: int64;
begin
  if timeout = 0 then Result := true
  else if timeout = INFINITE then Result := false
  else begin
    stop := GetTickCount;
    if stop < start
      then stop := stop + $100000000;
    Result := ((stop-start) > timeout);
  end;
end; { TLookupEngine.Elapsed }

function GetMSDNHandleEnum(hWindow: HWND; resPtr: LPARAM): boolean; stdcall;
begin
  if SameText(GetClassNameStr(hWindow),'HH Parent') and
     (StrLIComp(PChar(GetWindowTextStr(hWindow)),'MSDN Library',Length('MSDN Library')) = 0) then
  begin
    HWND(pointer(resPtr)^) := hWindow;
    Result := false;
  end
  else
    Result := true;
end;

function TLookupEngine.GetMSDNHandle: HWND;
begin
  Result := 0;
  EnumWindows(@GetMSDNHandleEnum,LPARAM(@Result));
end;

function TLookupEngine.LocateMSDNWindows(searchInIndex, waitForStart: boolean): boolean;
var
  start: DWORD;
  hhChild: HWND;
  unnamed: HWND;
  combo: HWND;
begin
  start := GetTickCount;
  repeat
    Result := false;
    hMSDN := GetMSDNHandle;
    {$IFOPT D+} SendDebugEx('MSDN Lookup / hMSDN: '+IntToStr(hMSDN), mtInformation); {$ENDIF}
    if hMSDN <> 0 then begin
      (* Expected MSDN window hierarchy:

        - when Index page is active
        |MSDN Library - January 2000/HH Parent
          |/ToolbarWindow32
          |/HH Child
            ...
          |/HH SizeBar
          |Active Su&bset/Static
          |/ComboBox
          |/HH Child
            |/SysTabControl32
            |Type in the key&word to find:/Static
            |/Edit
            |&Display/Button
            |/hh_kwd_vlist

        - when Search page is active
        |MSDN Library - January 2000/HH Parent
          |/ToolbarWindow32
          |/HH Child
            ...
          |/HH SizeBar
          |Active Su&bset/Static
          |/ComboBox
          |/HH Child
            |/SysTabControl32
              |/#32770
                |/ComboBox
                  |/Edit
                |/Button
                |&List Topics/Button
          ...

      *)
      hMSDNSysTab := 0;
      hMSDNEdit := 0;
      hhChild := FindWindowEx(hMSDN,0,'HH Child',nil);
      {$IFOPT D+} SendDebugEx('MSDN Lookup / hHHChild 1: '+IntToStr(hhChild), mtInformation); {$ENDIF}
      hhChild := FindWindowEx(hMSDN,hhChild,'HH Child',nil);
      {$IFOPT D+} SendDebugEx('MSDN Lookup / hHHChild 2: '+IntToStr(hhChild), mtInformation); {$ENDIF}
      if hhChild <> 0 then begin
        hMSDNSysTab := FindWindowEx(hhChild,0,'SysTabControl32',nil);
        {$IFOPT D+} SendDebugEx('MSDN Lookup / hSysTabControl32: '+IntToStr(hMSDNSysTab), mtInformation); {$ENDIF}
        if hMSDNSysTab <> 0 then begin
          ForceForegroundWindow(hMSDN);
          if SearchInIndex then begin
            ActivateTab(1);
            hMSDNEdit := FindWindowEx(hhChild,0,'Edit',nil);
            {$IFOPT D+} SendDebugEx('MSDN Lookup / hEdit: '+IntToStr(hMSDNEdit), mtInformation); {$ENDIF}
          end
          else begin
            ActivateTab(2);
            unnamed := FindWindowEx(hMSDNSysTab,0,PChar(32770),nil);
            {$IFOPT D+} SendDebugEx('MSDN Lookup / h32770: '+IntToStr(unnamed), mtInformation); {$ENDIF}
            if unnamed <> 0 then begin
              combo := FindWindowEx(unnamed,0,'ComboBox',nil);
              {$IFOPT D+} SendDebugEx('MSDN Lookup / hComboBox: '+IntToStr(combo), mtInformation); {$ENDIF}
              if combo <> 0 then begin
                hMSDNEdit := FindWindowEx(combo,0,'Edit',nil);
                {$IFOPT D+} SendDebugEx('MSDN Lookup / hEdit: '+IntToStr(hMSDNEdit), mtInformation); {$ENDIF}
              end;
            end;
          end;
        end;
      end;
      Result := (hhChild <> 0) and (hMSDNSysTab <> 0) and (hMSDNEdit <> 0);
    end;
    if Result or (not waitForStart) or Elapsed(start,CWaitOnMSDNToStart*1000) then
      break;
    Sleep(100);
  until false;
end;

procedure TLookupEngine.LookupTokenLocal(token, msdnCommand,
  msdnFolder: string; searchInIndex: boolean);
resourcestring
  SShellFailed = 'ShellExecute(%s,%s) failed with error %d!';
  STimeoutWaitingOnMSDN = 'Timed out waiting for MSDN to start!';
var
  shellRes: integer;
  progName: string;
  progParam: string;
begin
  if not LocateMSDNWindows(searchInIndex,false) then begin
    SplitCommand(msdnCommand,progName,progParam);
    {$IFOPT D+} SendDebugEx('MSDN Lookup / shell program: >'+progName+'<', mtInformation); {$ENDIF}
    {$IFOPT D+} SendDebugEx('MSDN Lookup / shell parameters: >'+progParam+'<', mtInformation); {$ENDIF}
    shellRes := ShellExecute(Application.Handle,PChar('open'),PChar(progName),PChar(progParam),PChar(msdnFolder),SW_NORMAL);
    if shellRes < 33 then
      raise Exception.CreateFmt(SShellFailed,[progName,progParam,shellRes]);
  end;
  if not LocateMSDNWindows(searchInIndex,true) then
    raise Exception.Create(STimeoutWaitingOnMSDN)
  else begin
    ForceForegroundWindow(hMSDN);
    StartMSDNSearch(token);
  end;
end;

procedure TLookupEngine.LookupTokenOnInternet(token, url: string);
resourcestring
  SNoTokenTag = 'Missing token placeholder (%s) in URL - check settings!';
  SNoBrowser = 'Browser could not be started!';
var
  p: integer;                          
begin
  p := Pos(UpperCase(CTokenTag),UpperCase(url));
  if p = 0 then
    raise Exception.CreateFmt(SNoTokenTag,[CTokenTag])
  else begin
    Delete(url,p,Length(CTokenTag));
    Insert(Escape(token),url,p);
    if ShellExecute(Application.Handle,PChar('open'),PChar(url),PChar(''),nil,SW_NORMAL) < 33 then
    if ShellExecute(Application.Handle,PChar('open'),PChar('netscape.exe'),PChar(url),nil,SW_NORMAL) < 33 then
    if ShellExecute(Application.Handle,PChar('open'),PChar('iexplore.exe'),PChar(url),nil,SW_NORMAL) < 33 then
      raise Exception.Create(SNoBrowser);
  end;
end;

procedure TLookupEngine.SplitCommand(cmd: string; var progName,
  progParam: string);
var
  p: integer;
  searchFor: char;
begin
  progName := '';
  progParam := '';
  cmd := Trim(cmd);
  if cmd <> '' then begin
    if cmd[1] = '"' then begin
      searchFor := '"';
      p := 2;
    end
    else begin
      searchFor := ' ';
      p := 1;
    end;
    while (p <= Length(cmd)) and (cmd[p] <> searchFor) do
      Inc(p);
    if p > Length(cmd) then
      Dec(p);
    progName := Trim(Copy(cmd,1,p));
    progParam := Trim(Copy(cmd,p+1,Length(cmd)-p));
  end;
end;

procedure TLookupEngine.StartMSDNSearch(token: string);
begin
{$IFOPT D+} SendDebugEx('MSDN Lookup / search >'+token+'<', mtInformation); {$ENDIF}
  if (hMSDNSysTab = 0) or (hMSDNEdit = 0) or (token = '') then
    Exit; // just a safety check - should never happen

{$IFOPT D+} SendDebugEx('MSDN Lookup / setting text>'+token+'<', mtInformation); {$ENDIF}

  // Set search text.
  SendMessage(hMSDNEdit,WM_SETTEXT,0,LPARAM(PChar(token)));

  // Start search.
  PostMessage(hMSDNEdit,WM_KEYDOWN,VK_RETURN,0);
  PostMessage(hMSDNEdit,WM_KEYUP,VK_RETURN,0);
end;

initialization
  RegisterGX_Expert(TMSDNLookupExpert);
end.