Главная страница | назад





Article #16858: Displaying documents in the default browser

 Question and Answer Database

FAQ1858D.txt - Displaying documents in the default browser

Category   :Internet/WEB
Platform   :All-32Bit
Product    :

Question:
How can I start the default browser with an URL in a new 
browser window?


Answer:
The following example attempts to start the specified URL 
in a new browser window. Note: Not all versions of 
Internet Explorer will respond with a new window.

Example:

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)] = #32)) 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('http://www.borland.com');
  StartNewBrowserWindow('http://www.yahoo.com');
end;


4/2/99 11:46:29 AM
 

Last Modified: 01-SEP-99