Autor Beitrag
Nagelbrett
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 75



BeitragVerfasst: Fr 07.03.03 22:59 
hi, ich weiß ja dass man, will man eine website in den standardbrowser laden, diese einfach nur an shellexecute übergeben muss

mein problem ist, dass diese seite dann aber, falls schon eine instanz des browsers läuft, immer in dieser geladen und quasi kein neues browser window geöffnet wird...

wie kann ich das umgehen und URLs immer in einem neuen window öffnen, auch wenn schon andere browser windows offen sind?
toms
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1099
Erhaltene Danke: 2



BeitragVerfasst: Fr 07.03.03 23:09 
So:

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
{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) > 0and 
    (s[1] = '"')) then 
    Delete(s, 11); 
  if ((Length(s) > 0and 
    (Pos('"', s) > 0)) then 
    Delete(s, Pos('"', s), Length(s)); 
  while ((Length(s) > 0and 
    (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;
Nagelbrett Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 75



BeitragVerfasst: Fr 07.03.03 23:36 
ahjo, danke :)