Problem beim Verknüpfung erstellen

[BullsEye]

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
USES SHLOBJ, ACTIVEX;
{$R *.dfm}

// Der Einfachheit halber heisst der Link genauso, wie die Datei 
function CreateDesktopLink(const p_sFilePath : string;const p_sDesktopDir : string) : Boolean;

const // Fehlende Deklaration in Delphi 
  // Zu finden in der Registry 
  // HKEY_CLASSES_ROOT\Interface 
  // nach IPersistFile suchen 
  IID_IPersistFile: TGUID = '{0000010b-0000-0000-C000-000000000046}'; 

var 
  slShellLink    : IShellLink;   // ShellLink Interface
  pfPersistFile  : IPersistFile; // Shortcut (Link) Permanent speichern 
  wszShortCut    : PWideChar;    // Buffer für den Shortcutnamen 
  hRes           : HResult;      // Für Zwischenergebnisse 
  sShortCut      : string;       // So heisst dann der Shortcut 
  dwLen          : DWORD; 

begin 
  Result := false; 
  // COM Object der Klasse ShellLink erzeugen 
  hRes := CoCreateInstance(CLSID_ShellLink,      // ID von ShellLink (Typ TGUID) 
                           nil, 
                           CLSCTX_INPROC_SERVER, 
                           IID_IShellLinkA,      // Referenz auf die Funktion 
                           slShellLink);         // Pointer auf IShellLink Interface 
  if hRes <> S_OK then 
  begin 
    exit; 
  end; 
  slShellLink.SetPath(PChar(p_sFilePath));                            // Auf diese Datei geht der Link 
  hRes := slShellLink.QueryInterface(IID_IPersistFile,pfPersistFile); // Pointer auf IPersist holen 
  if hRes <> S_OK then 
  begin 
    exit; 
  end; 
  dwLen := (MAX_PATH+1)*2; 
  wszShortcut := AllocMem(dwLen); 
  try 
    sShortCut := ChangeFileExt(p_sFilePath,'.LNK'); 
    sShortCut := p_sDesktopDir + '\' + ExtractFileName(sShortCut); 
    StringToWideChar(sShortCut,wszShortCut,dwLen); 
    hRes := pfPersistFile.Save(wszShortCut, TRUE); // Jetzt noch den Link speichern 
  finally 
    FreeMem(wszShortCut,dwLen);   // und den Platz wieder freigeben 
  end; 
  Result := (hRes = S_OK); 
end; 



procedure TForm1.Button1Click(Sender: TObject);
var 
  szDesktopFolder : PChar;

begin
  if Opendialog1.Execute then
  begin 
    szDesktopFolder := StrAlloc(MAX_PATH+1); 
    try 
      if not SHGetSpecialFolderPath(self.Handle,szDesktopFolder,CSIDL_COMMON_DESKTOPDIRECTORY,false) then 
      begin 
        ShowMessage(SysErrorMessage(GetLastError)); 
        exit; 
      end; 
      if not CreateDesktopLink(OpenDialog1.FileName,szDesktopFolder) then 
      begin 
        ShowMessage(SysErrorMessage(GetLastError)); 
      end; 
    finally 
      StrDispose(szDesktopFolder); 
    end; 
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;

initialization
begin 
  CoInitialize(nil); 
end; 

finalization 
begin 
  CoUninitialize;
end;

end.