Tipy a triky v Delphi, díl 115. - zkoumáme Internet Explorer

Dneska se budeme věnovat Internet Exploreru. Ukážeme si, jak získat seznam naposledy vložených adres a jak zjistit aktuální adresu v adresovém řádku.
Nejprve tedy seznam adres. Aby nedošlo hned na začátku k omylu, nejedná se o seznam naposledy navštívených adres, ale adres, které byly zadány do adresového řádku a odeslány. Tentýž seznam získáte rozbalením právě adresového řádku přímo v IE.

Jak tedy adresy získat? Je to velmi snadné a možná vás už napadlo jak na to. Ano, i tentokrát bude řeč o registrech systému, protože právě zde jsou uloženy. Jelikož jsme si již o registrech povídali mnohokrát, není třeba vlastně nic dodávat, protože vše bude jasné ze zdrojového kódu. Pro náš příklad umístěte na formulář ListBox, kam budou adresy vypsány, a také tlačítko, kterým celou akci jako obvykle spustíme.

Druhý příklad ukazuje, jak se prostřednictvím DDE "napíchnout" na Internet Explorer a zjistit aktuální stránku v adresovém řádku. Navíc zjistíme i titulek aktuální stránky. Tuto funkci nám aktivuje druhé tlačítko, takže jej rovněž přidejte na formulář.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry, DDEMan;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure ShowTypedUrls(Urls: TStrings);
var
  Reg: TRegistry;
  S: TStringList;
  i: Integer;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey(`Software\Microsoft\Internet Explorer\TypedURLs`, False) then
    begin
      S := TStringList.Create;
      try
        reg.GetValueNames(S);
        for i := 0 to S.Count - 1 do Urls.Add(reg.ReadString(S.Strings[i]));
      finally
        S.Free;
      end;
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;

function GetURL(Service: string): string;
var
  ClDDE: TDDEClientConv;
  temp: PChar;
begin
  Result := ``;
  ClDDE := TDDEClientConv.Create(nil);
  with ClDDE do
  begin
    SetLink(Service, `WWW_GetWindowInfo`);
    temp := RequestData(`0xFFFFFFFF`);
    Result := StrPas(temp);
    StrDispose(temp);
    CloseLink;
  end;
  ClDDE.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowTypedUrls(ListBox1.Items);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessage(GetURL(`IExplore`));
end;

end.

Pokud při volání funkce GetURL nahradíme parametr IExplore za Netscape, měla by funkce pracovat i s tímto prohlížečem.

Na výstupu pak dostaneme řetězec, který obsahuje adresu a zmiňovaný titulek stránky, oddělený čárkou.

Diskuze (1) Další článek: Red Hat Linux končí, bude už jen Red Hat Enterprise

Témata článku: , , , , , , , , , ,