Открыть URL в новом стандартном окне TWebBrowser 2

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

 { From: http://community.borland.com/article/0,1410,16858,00.html }

 uses
   DdeMan,
 {$IFDEF WIN32}
   Registry; {We will get it from the registry}
 {$ELSE}
   IniFiles; {We will get it from the win.ini file}
 {$ENDIF}

 {$IFNDEF WIN32}
 const
    MAX_PATH = 144;
   {$ENDIF}

 function GetProgramAssociation(Ext: string): string;
 var
   {$IFDEF WIN32}
   reg: TRegistry;
   s: string;
   {$ELSE}
   WinIni: TIniFile;
   WinIniFileName: array[0..MAX_PATH] of Char;
   s: string;
   {$ENDIF}
 begin
   {$IFDEF WIN32}
   s := "";
   reg := TRegistry.Create;
   reg.RootKey := HKEY_CLASSES_ROOT;
   if reg.OpenKey("." + ext + "\shell\open\command",
     False) <> False then
    begin
     {The open command has been found}
     s := reg.ReadString("");
     reg.CloseKey;
   end
    else
    begin
     {perhaps thier is a system file pointer}
     if reg.OpenKey("." + ext,
       False) <> False then
      begin
       s := reg.ReadString("");
       reg.CloseKey;
       if s <> "" then
        begin
         {A system file pointer was found}
         if reg.OpenKey(s + "\shell\open\command",
           False) <> False then
           {The open command has been found}
           s := reg.ReadString("");
         reg.CloseKey;
       end;
     end;
   end;
   {Delete any command line, quotes and spaces}
   if Pos("%", s) > 0 then
     Delete(s, Pos("%", s), Length(s));
   if ((Length(s) > 0) and
     (s[1] = """)) then
     Delete(s, 1, 1);
   if ((Length(s) > 0) and
     (Pos(""", s) > 0)) then
     Delete(s, Pos(""", s), Length(s));
   while ((Length(s) > 0) and
     (s[Length(s)] = " ")) do
     Delete(s, Length(s), 1);
   {$ELSE}
   GetWindowsDirectory(WinIniFileName, SizeOf(WinIniFileName));
   StrCat(WinIniFileName, "\win.ini");
   WinIni := TIniFile.Create(WinIniFileName);
   s  := WinIni.ReadString("Extensions",ext,"");
   WinIni.Free;
   {Delete any command line}
   if Pos(" ^", s) > 0 then
     Delete(s, Pos(" ^", s), Length(s));
   {$ENDIF}
   Result := s;
 end;

 procedure StartNewBrowserWindow(URL: string);
 var
   DDEConv: TDDEClientConv;
   URLFired: bool;
   App: string;
   UpApp: string;
   p: array[0..MAX_PATH] of Char;
 begin
   UrlFired := False;
   App := GetProgramAssociation("HTM");
   UpApp := Uppercase(App);
   Delete(App, Pos(".EXE", UpAPP), Length(App));
   if Pos("NETSCAPE.EXE",
     UpApp) > 0 then
    begin
     DDEConv := TDDEClientConv.Create(nil);
     DDEConv.ServiceApplication := App;
     if DDEConv.SetLink("NETSCAPE", "WWW_OpenURL") then
       if DDEConv.RequestData(URL + ",,0x0,0x0") <> nil then
         if DDEConv.SetLink("NETSCAPE", "WWW_Activate") then
           URLFired := DDEConv.RequestData("0xFFFFFFFF,0x0") <> nil;
     DDEConv.Free;
   end
    else if Pos("IEXPLORE.EXE",
     UpApp) > 0 then
    begin
     DDEConv := TDDEClientConv.Create(nil);
     DDEConv.ServiceApplication := App;
     if DDEConv.SetLink("iexplore", "WWW_OpenURL") then
       if DDEConv.RequestData(URL + ",,0") <> nil then
         if DDEConv.SetLink("iexplore", "WWW_Activate") then
           URLFired := DDEConv.RequestData("0,0") <> nil;
     DDEConv.Free;
   end;
   if UrlFired = False then
     WinExec(StrPCopy(@p, URL), SW_SHOWNORMAL);
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 begin
   StartNewBrowserWindow("?wurl=www.borland.com");
   StartNewBrowserWindow("?wurl=www.yahoo.com");
 end;

Обсудить статью на форуме