ShellFolder anlegen?

[MathiasSimmack]

So, nach ein bisschen Ge-Google bin ich u.a. auf dieser russischen Seite gelandet, die ein komplettes VB-Skript enthielt. Was VBS kann, kann ich mit Delphi schon lange, dachte ich mir, und voilà:

Delphi-Quellcode:

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;

Beispielaufruf:

Delphi-Quellcode:

CreateFolderShortCut(
  'g:\test',        // <-- der anzulegende Ordner auf G:\ (= FAT-Partition)
  'c:\LastCrap');   // <-- das Ziel auf C:\ (= FAT-Partition)

Muss noch was verbessert werden?

btw: Vielleicht könnte mal jemand, der des Russischen mächtig ist, den Satz übersetzen, in dem XP, 2000 und ME genannt werden. Meine Vermutung ist (ich hatte Russisch mal in der Schule, spreche aber inzwischen kein Wort mehr ... ... Na ja, außer "Ich heiße ...", "Ich wohne ...", "Gehen wir zu dir oder zu mir?"), dass dort gesagt wird: Unter XP und 2000 funktioniert´s, unter ME (und damit generell unter 9x) nicht ...


Nico-Modus: Editiert, während andere (hoffentlich) den Beitrag gerade lesen