unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMan, ComCtrls, ActnList, Menus;

type
  TMainForm = class(TForm)
    XPManifest: TXPManifest;
    FindButton: TButton;
    ActionList: TActionList;
    PopupMenu: TPopupMenu;
    ExtractURLsAction: TAction;
    ListBox: TListBox;
    Button1: TButton;
    LoadURLAction: TAction;
    LoadAllAction: TAction;
    Button2: TButton;
    URLs1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ClearAction: TAction;
    procedure ExtractURLsActionExecute(Sender: TObject);
    procedure LoadURLActionExecute(Sender: TObject);
    procedure LoadAllActionExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure ClearActionExecute(Sender: TObject);
  private
    { Private declarations }
  public
    FFileName: string;
    procedure OpenURL(const AURL: string);
  end;

var
  MainForm: TMainForm;

const
  IEClass = 'IEFrame';

implementation

{$R *.dfm}

uses ShellAPI;

// Перебор дочерних окон.
function EnumChildProc(H: HWnd;
                      lParam: LongInt): Boolean; stdcall;
var
  FChildClass, FLink: array[0..$1FF] of Char;
begin
  FillChar(FLink, SizeOf(FLink), 0);
  GetClassName(H, FChildClass, SizeOf(FChildClass));
  Result:= True;

  if FChildClass = 'Edit'
    then begin
          // Получаю текст из адресной строки. Только через WM_GETTEXT!
          // GetWindowText(H, FLink, SizeOf(FLink)); - не работает!!
          SendMessage(H, WM_GETTEXT, SizeOf(FLink), Integer(@FLink));
          MainForm.ListBox.Items.Add(string(FLink));
        end;
end;

// Перебор окон верхнего уровня.
function EnumProc(H: HWnd;
                  lParam: LongInt): Boolean; stdcall;
var
  FName, FClass: array[0..$1FF] of Char;
begin
  Result := True;
  GetWindowText(H, FName, SizeOf(FName));
  GetClassName(H, FClass, SizeOf(FClass));
  if FClass = IEClass
    then EnumChildWindows(H, @EnumChildProc, H);
end;

procedure TMainForm.ExtractURLsActionExecute(Sender: TObject);
begin
  ListBox.Items.BeginUpdate;
  try
    ListBox.Items.Clear;
    EnumWindows(@EnumProc, 0);
  finally
    ListBox.Items.EndUpdate;
  end;
end;

procedure TMainForm.LoadURLActionExecute(Sender: TObject);
var
  Index: Integer;
begin
  for Index:= 0 to ListBox.Count - 1 do
    if ListBox.Selected[Index]
      then OpenURL(ListBox.Items[Index]);
end;

procedure TMainForm.LoadAllActionExecute(Sender: TObject);
var
  Index: Integer;
begin
  for Index:= 0 to ListBox.Count - 1 do
    OpenURL(ListBox.Items[Index]);
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ListBox.Items.SaveToFile(FFileName);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FFileName:= ChangeFileExt(Paramstr(0), 'txt');
  if FileExists(FFileName)
    then ListBox.Items.LoadFromFile(FFileName);
end;

procedure TMainForm.OpenURL(const AURL: string);
begin
  ShellExecute(Handle,
              'open',
              'iexplore.exe',
              PChar(AURL),
              nil,
              SW_ShowNormal);
end;

procedure TMainForm.ClearActionExecute(Sender: TObject);
begin
  ListBox.Clear;
end;

end.