...open a URL in a New Standard Webbrowser Window?

Author: czrx

Category: Internet / LAN

{1.}

uses
  
ShellAPI, Registry;

procedure OpenURL(Url: string);
var
  
ts: string;
begin
  with 
TRegistry.Create do
    try
      
rootkey := HKEY_CLASSES_ROOT;
      OpenKey('\htmlfile\shell\open\command', False);
      try
        
ts := ReadString('');
      except
        
ts := '';
      end;
      CloseKey;
    finally
      
Free;
    end;
  if ts = '' then Exit;
  // remove quotes and commandline parameters
  
ts := Copy(ts, Pos('"', ts) + 1, Length(ts));
  ts := Copy(ts, 1, Pos('"', ts) - 1);
  ShellExecute(0, 'open', PChar(ts), PChar(url), nil, SW_SHOW);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  
OpenURL('http://www.SwissDelphiCenter.ch');
end;


{2.}

{**************************************************************}
{ 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)] = #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;

 

printed from
www.swissdelphicenter.ch
developers knowledge base