Autor Beitrag
trm
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 491
Erhaltene Danke: 19

Windows 7x64
Delphi 7
BeitragVerfasst: Do 01.07.10 00:28 
Huhu,

ich habe schon etliche Beiträge durchsucht, jedoch keine Lösung für folgendes Probelem gefunden:

ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
  if FileExists(HelpPfad + HelpFileName) then
    ShowURL('file:///' + HelpPfad + HelpFileName, '#' + Dummy_String);

procedure TForm1.ShowURL(URL, Nav: string);
begin

  if Length(Trim(Nav)) > 0 then
    URL := '"' + URL + Nav + '"';
  ShellExecute(Application.Handle, PAnsiChar('open'), PAnsiChar(Url), PAnsiChar(Nav), nil, SW_SHOWNORMAL);

end;


Das Problem hier ist: der Anker wird nicht mehr als Parameter weitergegeben. Unter Windows XP ging das noch einwandfrei.
Das gleiche Problem hatte auch Lemmy vor längerer Zeit, ich habe Windows7 erst seit ein paar Wochen und er gab leider keine Rückmeldung.
Nun stehe ich vor der gleichen Situation.

Die URL wird immer geöffnet ohne Anker.
Einen direkten Verweis auf den IE z.B. möchte ich nicht.

Hat jemand eine Idee bitte ?

Viele Grüße
~Mathias

Moderiert von user profile iconNarses: URL-Tags ergänzt.
Gerd Kayser
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 632
Erhaltene Danke: 121

Win 7 32-bit
Delphi 2006/XE
BeitragVerfasst: Mo 05.07.10 11:15 
user profile icontrm hat folgendes geschrieben Zum zitierten Posting springen:
Das Problem hier ist: der Anker wird nicht mehr als Parameter weitergegeben.

So geht's (getestet unter Windows 7 mit BDS 2006 und dem Internet Explorer):
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
procedure TForm1.Button2Click(Sender: TObject);
var
  Befehl      : string;
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  Befehl := '"c:\program files\internet explorer\iexplore.exe" File:///f:\test2\a_name.htm#kap02';
  CreateProcess(nil,
                PChar(Befehl),
                nil,
                nil,
                false,
                0,
                nil,
                'c:\',
                StartupInfo,
                ProcessInfo);
end;
Andreas L.
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 1703
Erhaltene Danke: 25

Windows Vista / Windows 10
Delphi 2009 Pro (JVCL, DragDrop, rmKlever, ICS, EmbeddedWB, DEC, Indy)
BeitragVerfasst: Mo 05.07.10 11:35 
@Gerd Kayser:

Einen Verweis auf den IE will er ja nicht.

@trm:

Wenn du den Anker nicht als Parameter übergibst sondern an die URL anhängst sollte es funktionieren.
Gerd Kayser
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 632
Erhaltene Danke: 121

Win 7 32-bit
Delphi 2006/XE
BeitragVerfasst: Mo 05.07.10 12:22 
user profile iconAndreas L. hat folgendes geschrieben Zum zitierten Posting springen:
Einen Verweis auf den IE will er ja nicht.

Es führt kein Weg daran vorbei: Der Browser muß bei CreateProcess voll qualifiziert in Gänsefüßchen davor gesetzt werden. Wenn er das nicht will, dann muß er eben damit leben, daß die Sprungmarken nicht angesprungen werden können.

Zitat:
Wenn du den Anker nicht als Parameter übergibst sondern an die URL anhängst sollte es funktionieren.

Mit ShellExecute funktioniert es überhaupt nicht.
trm Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 491
Erhaltene Danke: 19

Windows 7x64
Delphi 7
BeitragVerfasst: Mo 05.07.10 12:25 
Hallo ihr 2,

Gerd, Dein Beispiel mag funktionieren, ist aber leider wieder zu abhängig ;)

Andreas, bis Windows XP ging das auch noch. Aber mit der neuen Technik zu Codeausführungverhinderung hat Microsoft auch dieses Verhalten geändert (das habe ich jedenfalls so verstanden, als ich im msdn gestöbert habe).

Hier newoldthing.wordpres...the-default-browser/ ist ein schöner Artikel, den ich gefunden habe. Vielleicht werde ich damit etwas brauchbares hinbekommen. Dann würde Gerd sein Code hilfreich sein :)
MaPsTaR
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 90
Erhaltene Danke: 4

Win XP
Delphi 7 Enterprise
BeitragVerfasst: Mo 05.07.10 12:30 
Hallo,

leider hast du, während ich das hier geschrieben hab schon geantwortet... :-(

ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
function TForm1.GetDefaultBrowserPath: String;
var Reg: TRegistry;
    DefBrowser: String;
begin
  result := '';
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CLASSES_ROOT;
  if Reg.OpenKey('.html', false)
  then
  begin
    DefBrowser := Reg.ReadString('');
    Reg.CloseKey;
    if Reg.OpenKey(DefBrowser + '\shell\open\command', false)
    then
    begin
      result := Reg.ReadString('');
      Reg.CloseKey;
    end;
  end;
  Reg.Free;
end;


Da ich Win 7 nicht benutze kann ich aber nicht garantieren, dass die Registry-Pfade dort auch stimmen, unter XP läuft das aber auf jeden Fall.

Gruß

_________________
Liebe Kinder, es stimmt ... solnage auch nur der ertse und lezte Bchutsabe rihctig ist und alle andreen Bcuhsatben irgendwie vorahnden sind,
dann knan man es dennonch lesen, also macht nur weiter so, wir verstehen euch schon
trm Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 491
Erhaltene Danke: 19

Windows 7x64
Delphi 7
BeitragVerfasst: Mo 05.07.10 12:42 
Huhu, ich nochmal :)

MaPsTaR, danke für Deine Hilfe.

ausblenden Quelltext
1:
2:
3:
4:
5:
6:
7:
Windows Vista+
HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\http\UserChoice -> ProgID
 --> HKEY_CLASSES_ROOT\IE.HTTP\shell\open\command -> Standard IE
 --> HKEY_CLASSES_ROOT\FirefoxURL\shell\open\command -> Standard FF

Windows 9x+
 HKEY_CLASSES_ROOT\http\shell\open\command


Ich probiere das folgendermaßen. Erst teste ich, obe es einen Eintrag/ob es den Key UserChoice gibt.
Wenn ja, könnte es sein, dass ein Windows Vista oder höher vorhanden ist.
Dann lese ich HKEY_CLASSES_ROOT aus und schaue, ob dort ein korrektes Protokoll vorhanden ist. Wenn ja, prüfen, ob das programm dahinter auch existiert. Wenn ja, bin ich hier fertig.

Sollte oben irgendwann ein NEIN kommen, lese ich den Windowsstandard aus -> HKEY_CLASSES_ROOT\http\shell\open\command

Ich denke, das sollte so klappen - oder hat jemand einen Fehler entdeckt?

Gruß und danke nochmal an alle Helfer(innen) :D
~Mathias
Gerd Kayser
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 632
Erhaltene Danke: 121

Win 7 32-bit
Delphi 2006/XE
BeitragVerfasst: Mo 05.07.10 12:46 
user profile icontrm hat folgendes geschrieben Zum zitierten Posting springen:
Gerd, Dein Beispiel mag funktionieren, ist aber leider wieder zu abhängig ;)

Mein Beispiel zeigt anhand des Internet Explorers, wie es geht, nämlich mit CreateProcess. Da ich andere Browser nicht installiert habe, mußt Du das noch austesten.

---Moderiert von user profile iconNarses: Beiträge zusammengefasst---

user profile icontrm hat folgendes geschrieben Zum zitierten Posting springen:
Wenn ja, könnte es sein, dass ein Windows Vista oder höher vorhanden ist.

Dafür gibts die Funktion GetVersionEx. Damit bekommst Du die Windows-Version heraus.
trm Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 491
Erhaltene Danke: 19

Windows 7x64
Delphi 7
BeitragVerfasst: Mo 05.07.10 13:40 
Huhu und

JUHU :D

Ich habs hinbekommen.

Hier mal mein Ergebnis.

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:
function TForm1.GetDefaultBrowser(var _path, _browser: string): Boolean;
var
  Reg: TRegistry;
  Dummy_String: string;
  Dummy_Bool: Boolean;
  DefBrowser: string;
begin

{
  HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\http\UserChoice - > ProgID
    - - > HKEY_CLASSES_ROOT\IE.HTTP\shell\open\command - > Standard IE
    - - > HKEY_CLASSES_ROOT\FirefoxURL\shell\open\command - > Standard FF

  HKEY_CLASSES_ROOT\http\shell\open\command
}


  Result := False;
  Reg := TRegistry.Create;

  Reg.RootKey := HKEY_CURRENT_USER;
  Dummy_Bool := Reg.OpenKeyReadOnly('HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\http\UserChoice');
  if Dummy_Bool then
  begin
    Dummy_String := Reg.ReadString('ProgID');
    Reg.CloseKey;

    Reg.RootKey := HKEY_CLASSES_ROOT;
    Dummy_Bool := Reg.OpenKeyReadOnly(Dummy_String + '\shell\open\command');
    if Dummy_Bool then
    begin
      DefBrowser := Reg.ReadString('');
      Reg.CloseKey;
    end;
  end;
  Reg.CloseKey;

  if not Dummy_Bool then
  begin
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Dummy_Bool := Reg.OpenKeyReadOnly('.html');
    if Dummy_Bool then
    begin
      DefBrowser := Reg.ReadString('');
      Reg.CloseKey;
      Dummy_Bool := Reg.OpenKeyReadOnly(DefBrowser + '\shell\open\command');
      if Dummy_Bool then
        DefBrowser := Reg.ReadString('');
      Reg.CloseKey;
    end;
  end;

  Reg.Free;

  if Dummy_Bool then
  begin
    Dummy_Bool := Length(DefBrowser) > 0;
    while Pos('""', DefBrowser) > 0 do
      DefBrowser := StringReplace(DefBrowser, '""''"', [rfReplaceAll]);
    if Pos('"', DefBrowser) > 0 then
    begin
      if DefBrowser[1] = '"' then
        DefBrowser := copy(DefBrowser, 2, MaxInt);
      DefBrowser := copy(DefBrowser, 0, Pos('"', DefBrowser) - 1);
    end;
    while Pos('"', DefBrowser) > 0 do
      DefBrowser := StringReplace(DefBrowser, '"''', [rfReplaceAll]);
    _path := ExtractFilepath(DefBrowser);
    _browser := ExtractFilename(DefBrowser);

    Result := Dummy_Bool;
  end;

end;

procedure TForm1.ShowURL(URL, Nav: string);
var
  BrowserPfad, BrowserBin: string;
  Befehl: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Dummy_Bool: Boolean;
begin

  if Length(Trim(Nav)) > 0 then
    URL := URL + Nav;

  Dummy_Bool := GetDefaultBrowser(BrowserPfad, BrowserBin);

  if Dummy_Bool then
  begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    StartupInfo.cb := SizeOf(TStartupInfo);
    Befehl := Format('"%s" "%s"', [BrowserPfad + BrowserBin, URL]);
    CreateProcess(nil,
      PChar(Befehl),
      nil,
      nil,
      false,
      0,
      nil,
      'c:\',
      StartupInfo,
      ProcessInfo);
  end;

  if not Dummy_Bool then
    ShellExecute(Handle, PAnsiChar('open'), PAnsiChar(Url), nilnil, SW_SHOWNORMAL);

end;



GetDefaultBrowser(var _path, _browser: string) habe ich mit Absicht mit 2 Variablen versehen, weil man so gleich auch einen Text hat, falls man was ausgeben muss. Damit erspart man sich manuelles Extract...

ShowURL(URL, Nav: string) ist auch geteilt, das blieb noch übrig vom Testen. So hat man für spätere Ereignisse auch gleich wieder mehr Flexibilität.

Falls möglich, kann das bitte jemand nochmal durchgucken, ob evtl. bei GetDefaultBrowser, bei den StringReplace etwas optimiert werden kann?
Ich musste das so machen, weil ein einfaches ExtractFileName nicht funktionierte, da z.B. beim Firefox-Protokoll noch Parameter dabei standen ('"C:\Program Files (x86)\Mozilla Firefox\firefox.exe" -requestPending -osint -url "%1"' -> Windows 7x64).

Ach, Gerd: Natürlich hast Du Recht, dass Dein Code ok war. Ich wollte Deine Hilfe auch nicht schlecht machen, es war nur eine Aussage von mir mit der Bindung..
..aber wie Du siehst, habe ich versucht eine Lösung für mich zu finden :)


Testen kann das eigentlich jeder, der verschiedene Browser installiert hat und Rechte zum Setzen eines neuen Standardbrowsers besitzt.
Rein theorethisch sollte es auch ab Windows95 laufen, ohne extra eine Windowsversionsprüfung vornehmen zu müssen.

Danke nochmal und bis bald,

~Mathias :)

Edit: RS-Fehler gefunden :(
Edit2: Fehler im Code gefunden (hatte begin .. end vergessen)