link aus listbox aufrufen

peter31ac · Hält's aus hier Beiträge: 14

Hallo zusammen,
ich habe eine procedure geschrieben mit der ich mir in einer listbox den Inhalt meines Internetfavoritenordners anzeigen lassen kann.

Vielleicht bin ich ja mittlerweile total verblödet, aber ich möchte nun nichts anderes machen als mit einem Klick auf einen Eintrag in der listbox den IE starten und mir die gewünschte Website ansehen.

Also mit shellexecute kann ich einen link einfach aufrufen. Geht das auch aus der listbox?

Ich weiß so werde ich bestimmt nicht in den Delphi Himmel kommen!!!!!

Gruß
Peter :roll:

Ehemaliges Mitglied Erhaltene Danke: 1

peter31ac hat folgendes geschrieben:

Hallo zusammen,
ich habe eine procedure geschrieben mit der ich mir in einer listbox den Inhalt meines Internetfavoritenordners anzeigen lassen kann.

Kein Popupmenü mehr? :wink:

Zitat:

Vielleicht bin ich ja mittlerweile total verblödet ...

Kann ich nicht beurteilen. :twisted:

Zitat:

... aber ich möchte nun nichts anderes machen als mit einem Klick auf einen Eintrag in der listbox den IE starten und mir die gewünschte Website ansehen.

So manch frommer Wünsch wird erfüllt ...

Zitat:

Also mit shellexecute kann ich einen link einfach aufrufen. Geht das auch aus der listbox?

Ja. Offenbar kennst du den Befehl bereits, wie man eine URL mit Hilfe von ShellExecute() anzeigen lassen kann. Nun, du benötigst einfach nur den ausgewählten Eintrag der Listbox, und den bekommst du über "ItemIndex" heraus. Wenn du den dann als PCHAR an ShellExecute() weiterreichst, sollte es funktionieren. Was heißt "sollte"? Bei mir geht´s ...

Zitat:

Ich weiß so werde ich bestimmt nicht in den Delphi Himmel kommen!!!!!

Gute Programmierer kommen in den Delphi-Himmel, böse überall hin ...

peter31ac · Hält's aus hier Beiträge: 14

Hi Mathias,
doch doch das PopUPMenu ist noch immer aktuell. Um ehrlich zu sein klappt das noch nicht so ganz wie ich mir das vorstelle. Dein Speedy hat mir da nur bedingt geholfen. Das liegt aber daran, daß ich noch zu wenig über Delphi weiß. Aber ich bin ja lernfähig.
Und wo wir gerade beim Thema sind.
Deinen Tip mit dem ItemIndex habe ich gestern Abend mal versucht um zusetzen. Fehlanzeige.

Wenn du lust und Zeit hast kanst du dir ja mal den Quellcode ansehen.
Der kommt auch aus dem Internet.

markieren

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:

unit favoriten;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  ShlObj, ActiveX;

function GetIEFavourites(const favpath: string): TStrings; 
var 
  searchrec: TSearchRec; 
  str: TStrings;
  path, dir, FileName: string; 
  Buffer: array[0..2047] of Char; 
  found: Integer; 
begin 
  str := TStringList.Create; 
  // Get all file names in the favourites path 
  path  := FavPath + '\*.url'; 
  dir   := ExtractFilepath(path); 
  found := FindFirst(path, faAnyFile, searchrec); 
  while found = 0 do 
  begin 
    // Get now URLs from files in variable files 
    Setstring(FileName, Buffer, GetPrivateProfilestring('InternetShortcut', 
      PChar('URL'), nil, Buffer, SizeOf(Buffer), PChar(dir + searchrec.Name))); 
    str.Add(FileName); 
    found := FindNext(searchrec); 
  end; 
  // find Subfolders 
  found := FindFirst(dir + '\*.*', faAnyFile, searchrec); 
  while found = 0 do 
  begin 
    if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> '.') then 
      str.Addstrings(GetIEFavourites(dir + '\' + searchrec.Name)); 
    found := FindNext(searchrec); 
  end; 
  FindClose(searchrec); 
  Result := str; 
end; 

procedure FreePidl(pidl: PItemIDList); 
var 
  allocator: IMalloc; 
begin 
  if Succeeded(SHGetMalloc(allocator)) then 
  begin 
    allocator.Free(pidl); 
    {$IFDEF VER100} 
    allocator.Release; 
    {$ENDIF} 
  end; 

  end;

procedure TForm1.FormCreate(Sender: TObject);
var 
  pidl: PItemIDList; 
  FavPath: array[0..MAX_PATH] of Char; 
begin 
  if Succeeded(ShGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl)) then 
  begin 
    if ShGetPathfromIDList(pidl, FavPath) then 
      ListBox1.Items := GetIEFavourites(StrPas(FavPath)); 
    // The calling application is responsible for freeing the PItemIDList-pointer 
    // with the Shell's IMalloc interface 
    FreePIDL(pidl); 
end;

end;
end.

Wie würde ich denn nun mit einem klick den link öffnen??

Ehemaliges Mitglied Erhaltene Danke: 1

peter31ac hat folgendes geschrieben:

Dein Speedy hat mir da nur bedingt geholfen. Das liegt aber daran, daß ich noch zu wenig über Delphi weiß.

Dann war´s ohnehin ein schlechtes Beispiel, weil es auf die VCL komplett verzichtet.

Zitat:

Aber ich bin ja lernfähig.

Sehr gut.

Zitat:

Deinen Tip mit dem ItemIndex habe ich gestern Abend mal versucht um zusetzen. Fehlanzeige.

Also. Bitte geh mal davon aus, dass die folgende Listbox (LbFavorites) als Inhalt alle URL-Dateien enthält (inkl. Pfad und Endung). In dem Fall reicht folgendes Doppelklick-Ereignis aus, um die URL zu öffnen:

markieren

Quelltext

1:
2:
3:
4:
5:
6:

procedure TForm1.LbFavoritesDblClick(Sender: TObject);
begin
  with LbFavorites do
    if(ItemIndex <> -1) then
      ShellExecute(self.Handle,'open',pchar(Items[ItemIndex]),nil,nil,SW_SHOWNORMAL);
end;

So, jetzt muss ich allerdings gestehen, dass ich mir deinen Codeauszug nicht weiter angeschaut habe. :oops:

Ich habe mal aus einem älteren Programm eine Routine herausgesucht und so gestaltet, dass sie nicht nur einen Menüeintrag im TMainMenu sondern eben auch die o.g. Listbox füllt:

markieren

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:

uses
  ShellAPI, ShlObj;

//
// private "OnClick"-Prozedur zum Öffnen der URL
//
procedure TForm1.OnUrlClick(Sender: TObject);
begin
  with(Sender as TMenuItem) do
    if(Hint <> '') then
      ShellExecute(self.Handle,'open',pchar(Hint),nil,nil,SW_SHOWNORMAL);
end;

//
// Favoriten laden
//
procedure TForm1.LoadFavorites;

  // Favoritenordner heraussuchen
  function GetFavoritesPath(FavFolder: integer) : string;
  var
    lpItemId : PItemIdList;
    buffer   : array[0..MAX_PATH]of char;
  begin
    Result := ''; // zur Sicherheit

    if(SHGetSpecialFolderLocation(hInstance,FavFolder,lpItemId) = NOERROR) then
      if(SHGetPathFromIDList(lpItemId,buffer)) then
        begin
          Result := strpas(buffer); while(Result[length(Result)] = '\') do
                                      SetLength(Result,pred(length(Result)));
        end;
  end;

  // Favoriten laden
  procedure scanit(const homepath: string; parent: TMenuItem);
  var
    path : string;
    res  : integer;
    ds   : TSearchRec;
    mii  : TMenuItem;
  begin
    path := GetCurrentDir;

    // zuerst alle Verzeichnisse suchen (außer versteckten!)
    res := FindFirst('*.*',faAnyFile,ds);
    while(res = 0) do
      begin
        if(ds.Attr and faDirectory <> 0) and (ds.Attr and faHidden = 0) and
          ((ds.Name <> '.') and (ds.Name <> '..')) then
        begin
          // Verzeichnis ins Menü aufnehmen, ...
          mii         := TMenuItem.Create(nil);
          mii.Caption := ds.Name;
          parent.Add(mii);

          // ... rein springen und weitersuchen
          ChDir(ds.Name); scanit(homepath,mii);
        end;

        res := FindNext(ds); Application.ProcessMessages;
      end;
    FindClose(ds);

    // jetzt die eigentlichen Favoriten suchen
    res := FindFirst('*.url',faAnyFile,ds);
    while(res = 0) do
      begin
        if((ds.Name <> '.') and (ds.Name <> '..')) and
          (ds.Attr and faDirectory = 0) then
        begin
          // Datei hinzufügen
          mii            := TMenuItem.Create(nil);
          mii.Caption    := StringReplace(ChangeFileExt(ds.Name,''),
            '&','&&',[rfReplaceAll]);
          mii.Hint       := '"' + path + '\' + ds.Name + '"';
          mii.OnClick    := OnUrlClick;
          if(mii.Hint <> '') and (mii.Caption <> '') then
            parent.Add(mii);


// in die Listbox als URL einfügen -->
          LbFavorites.Items.Add(path + '\' + ds.Name);
        end;

        res := FindNext(ds); Application.ProcessMessages;
      end;
    FindClose(ds);

    if(path <> homepath) then ChDir('..');
  end;

var
  cDummy, xPath : string;
  mis : TMenuItem;
begin
  // wo bin ich?
  cDummy := GetCurrentDir;

  // die Favoriten des angemeldeten Benutzers einlesen
  xPath  := GetFavoritesPath(CSIDL_FAVORITES);
  if(xPath <> '') and (SetCurrentDir(xPath)) then
    scanit(xPath,IDM_FAVORITES);

//
// HINWEIS:
// der Menüeintrag im TMainMenu heißt bei mir "IDM_FAVORITES"!
// das muss an dein Programm angepasst werden, sonst siehst
// du nur ´ne Fehlermeldung
//


  // Separator einfügen
  mis         := TMenuItem.Create(nil);
  mis.Caption := '-';
  IDM_FAVORITES.Add(mis);

  // die Favoriten aller Benutzer einlesen
  xPath := GetFavoritesPath(CSIDL_COMMON_FAVORITES);
  if(xPath <> '') and (SetCurrentDir(xPath)) then
    scanit(xPath,IDM_FAVORITES);

  // zurück ins Ausgangsverzeichnis
  SetCurrentDir(cDummy);
end;

So, damit hätte ich einen Punkt erledigt (Listbox), inkl. Bonus (TMainMenu).

Fehlt noch das Popupmenü. Der Gedanke ist jetzt folgender: Bei der eben geposteten Funktion "LoadFavorites" wird vorausgesetzt, dass es einen übergeordneten Eintrag im TMainMenu gibt. Das funktioniert beim Popupmenü aber nicht, wenn das komplett leer ist und nur die Favoriten enthalten soll.
Angenommen, du benutzt dein Popupmenü auch für andere Zwecke, und es gäbe einen Eintrag "Favoriten" darin, dann könntest du die obige Funktion problemlos übernehmen. Anstelle von "IDM_FAVORITES" (TMenuItem im TMainMenu) müsstest du dann eben nur den Namen des Items im Popupmenü angeben, unter dem die Favoriten angezeigt werden sollen.

Für ein völlig leeres Popupmenü habe ich die Funktion ein wenig geändert, deswegen -obwohl´s augenscheinlich das selbe ist!- noch mal ein Codeposting:

markieren

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:

procedure TForm1.LoadPopupFavorites;

  // Favoritenordner heraussuchen
  // (s. Code oben)

  // Favoriten laden
  procedure scanit(const homepath: string; parent: TMenuItem);
  var
    path : string;
    res  : integer;
    ds   : TSearchRec;
    mii  : TMenuItem;
  begin
    path := GetCurrentDir;

    // zuerst alle Verzeichnisse suchen
    res := FindFirst('*.*',faAnyFile,ds);
    while(res = 0) do
      begin
        if(ds.Attr and faDirectory <> 0) and (ds.Attr and faHidden = 0) and
          ((ds.Name <> '.') and (ds.Name <> '..')) then
        begin
          // Verzeichnis ins Menü aufnehmen, ...
          mii         := TMenuItem.Create(nil);
          mii.Caption := ds.Name;
          if(parent = nil) then CtxFavorites.Items.Add(mii)
            else parent.Add(mii);

          // ... rein springen und weitersuchen
          ChDir(ds.Name); scanit(homepath,mii);
        end;

        res := FindNext(ds); Application.ProcessMessages;
      end;
    FindClose(ds);

    // jetzt die eigentlichen Favoriten suchen
    res := FindFirst('*.url',faAnyFile,ds);
    while(res = 0) do
      begin
        if((ds.Name <> '.') and (ds.Name <> '..')) and
          (ds.Attr and faDirectory = 0) then
        begin
          // Datei hinzufügen
          mii            := TMenuItem.Create(nil);
          mii.Caption    := StringReplace(ChangeFileExt(ds.Name,''),
            '&','&&',[rfReplaceAll]);
          mii.Hint       := '"' + path + '\' + ds.Name + '"';
          mii.OnClick    := OnUrlClick;
          if(mii.Hint <> '') and (mii.Caption <> '') then
            if(parent = nil) then CtxFavorites.Items.Add(mii)
              else parent.Add(mii);
        end;

        res := FindNext(ds); Application.ProcessMessages;
      end;
    FindClose(ds);

    if(path <> homepath) then ChDir('..');
  end;

var
  cDummy, xPath : string;
  mis : TMenuItem;
begin
  // wo bin ich?
  // (s. oben)

  // die Favoriten des angemeldeten Benutzers einlesen
  xPath  := GetFavoritesPath(CSIDL_FAVORITES);
  if(xPath <> '') and (SetCurrentDir(xPath)) then
    scanit(xPath,{ bitte beachten --> } nil);

  // Separator einfügen
  // (s. oben)

  // die Favoriten aller Benutzer einlesen
  xPath := GetFavoritesPath(CSIDL_COMMON_FAVORITES);
  if(xPath <> '') and (SetCurrentDir(xPath)) then
    scanit(xPath,nil);

  // zurück ins Ausgangsverzeichnis
  // (s. oben)
end;

Der Unterschied liegt a) darin, dass diese Funktion wirklich nur das Popupmenü (CtxFavorites) füllt, und b) in dieser Zeile darüber entschieden wird, ob ein neuer Eintrag angehangen oder unter einem evtl. vorhandenen Parent eingefügt wird:

markieren

Quelltext

1:
2:

if(parent = nil) then CtxFavorites.Items.Add(mii)
  else parent.Add(mii);

Abgesehen von diesen minimalen Änderungen sind beide Funktionen identisch, weshalb ich mich für das Doppelposting entschuldigen möchte. Aber dir, Peter, hilft´s hoffentlich weiter.

Gruß,
Mathias.

Ach so: Ich habe in diesem Beispiel nicht die URL-Dateien geöffnet und den Link ausgelesen. Da der Typ URL ja registriert ist, reicht ein Öffnen via "ShellExecute". Wenn dir nicht gefällt, dass dir die Listbox den Dateinamen anzeigt, Peter, dann müsstest du die Datei öffnen (TIniFile), den Link holen und den in die Listbox eintragen lassen. Am Doppelklick-Ereignis ändert das aber nichts.