..."Schlaue" Ordnerverknüpfungen für 2000/XP erste

Ehemaliges Mitglied Erhaltene Danke: 1

Anfang des Monats gab´s in der DP die Frage nach einer bestimmten Verknüpfung, bei der gleich der Inhalts des verlinkten Verzeichnisses angezeigt wird. Das Grundprinzip ist eine normale Verknüpfung, die allerdings zwingend den Namen "target.lnk" tragen muss, sowie eine versteckte "desktop.ini".
Ich dachte mir, das wäre auch was für die hiesigen FAQs. Ich musste den Beitrag nur erst mal suchen. :oops:

Der Titel bezieht sich auf die Übersetzung der russischen Seite, wo ich ein VB-Skript fand, das sich relativ einfach nach Delphi übersetzen ließ. Die Übersetzung stammt von einem DP-Mitglied, da mich mein Schul-Russisch mittlerweile doch im Stich gelassen hat.

Hier also der Code; nur die beiden genannten Units sind notwendig, darum lässt er sich auch problemlos in Konsolen/nonVCL-Programmen verwenden:

markieren

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:

uses
  ActiveX, ShlObj;

function CreateFolderShortCut(const DestinationPath, Folder: string):
  boolean;

  function CreateReadOnlyDir(const Path: string): boolean;
  begin
    // schreibgeschützten Ordner erzeugen, ...
    Result := (CreateDirectory(pchar(Path),nil)) and
      (SetFileAttributes(pchar(Path),FILE_ATTRIBUTE_READONLY)) and
    // ... & versteckte "desktop.ini" erzeugen
      (WritePrivateProfileString('.ShellClassInfo','CLSID2',
         '{0AFACED1-E828-11D1-9187-B532F1E9575D}',
         pchar(Path + '\desktop.ini'))) and
      (WritePrivateProfileString('.ShellClassInfo','Flags','2',
         pchar(Path + '\desktop.ini'))) and
      (SetFileAttributes(pchar(Path + '\desktop.ini'),
         FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM));
  end;

  function CreateComObject(const ClassID: TGUID;
    var OleResult : HRESULT): IUnknown;
  begin
    OleResult := CoCreateInstance(ClassID,nil,CLSCTX_INPROC_SERVER or
      CLSCTX_LOCAL_SERVER,IUnknown,Result);
  end;

var
  hr      : HRESULT;
  link    : IShellLink;
  pFile   : IPersistFile;
  pwcData : array[0..MAX_PATH]of widechar;
begin
  Result  := false;
  link    := nil;
  pFile   := nil;

  if(CoInitialize(nil) = S_OK) then
  try
    // Shortcut erzeugen
    link := CreateComObject(CLSID_ShellLink,hr) as IShellLink;
    if(hr = S_OK) and (link <> nil) then
    begin
      // Name für die Verknüpfung setzen
      ZeroMemory(@pwcData,sizeof(pwcData));
      if(StringToWideChar(DestinationPath + '\target.lnk',pwcData,
        sizeof(pwcData)) <> nil) then
      begin
        // Ordner erzeugen, ...
        if(CreateReadOnlyDir(DestinationPath)) then
        begin
          // Verknüpfungsziel setzen, ...
          link.SetPath(pchar(Folder));

          // ... & Verknüpfung erstellen
          pFile  := link as IPersistFile;
          Result := (pFile.Save(pwcData,true) = S_OK);
        end;
      end;
    end;
  finally
    if(pFile <> nil) then pFile := nil;
    if(link <> nil) then link := nil;

    CoUninitialize;
  end;
end;

Übergeben werden muss lediglich der gewünschte Zielordner, der angelegt wird, und der dann auch die Verknüpfung und die INI-Datei enthält, sowie der Ordner, dessen Inhalt angezeigt werden soll. Also bspw.:

markieren

Delphi-Quelltext

1:
2:
3:

CreateFolderShortCut(
  'g:\test',        // <-- der anzulegende Ordner auf G:\
  'c:\LastCrap');   // <-- der Ordner, dessen Inhalt angezeigt werden soll

Laut der o.g. russischen Seite funktioniert es unter Windows 2000 und XP. Der Code selbst lässt sich natürlich auch unter allen anderen Windows-Versionen kompilieren und ausführen. Nur viel Sinn macht es nicht, wenn das OS diese Funktionalität nicht kennt.

Wer also will, baut eine OS-Prüfung ein, die die Funktion mit false abbricht, wenn die Hauptversionsnummer < 5 ist.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme