скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

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



Оформил: DeeCo

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





Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook