Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Открыть 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('http://www.borland.com');
   StartNewBrowserWindow('http://www.yahoo.com');
 end;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.