Problem beim Verknüpfung erstellen

[Klaus01]

Delphi-Quellcode:

 
psl.SetPath(PChar(AFilename)); 
psl.SetDescription(PChar(ADescription)); 
psl.SetWorkingDirectory(PChar(ExtractFilePath(AFilename)) ;);

Pchar liefert einen Pointer auf ein UniCode String zurück.
Was psl.SetPath erwartet weiß ich nicht, vielleicht einen Pointer auf einen AnsiString.
Ich würde mal in diese Richtung suchen.

Grüße
Klaus

[DeddyH]

Mal zum Testen alles explizit auf ANSI umgestellt. Funktioniert es so?

Delphi-Quellcode:

function CreateLink(const AFilename, ALNKFilename, ADescription: Ansistring) : Boolean;
var
  psl : IShellLink;
  ppf : IPersistFile;
  wsz : PWideChar;
begin
  result:=false;
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,
  CLSCTX_inPROC_SERVER, IID_IShellLinkA, psl)) then
  begin
    psl.SetPath(PAnsiChar(AFilename));
    psl.SetDescription(PAnsiChar(ADescription));
    psl.SetWorkingDirectory(PAnsiChar(ExtractFilePath(AFilename)) ;);
    if SUCCEEDED(psl.QueryInterface(IPersistFile, ppf)) then
    begin
      GetMem(wsz, MAX_PATH*2);
      try
        MultiByteToWideChar(CP_ACP, 0, PAnsiChar(ALNKFilename), -1, wsz, MAX_PATH);
        ppf.Save(wsz, true);
        result:=true;
      finally
        FreeMem(wsz, MAX_PATH*2);
      end;
    end;
  end;
end;

[Sir K]

Zitat von DeddyH:

Mal zum Testen alles explizit auf ANSI umgestellt. Funktioniert es so?

Delphi-Quellcode:

function CreateLink(const AFilename, ALNKFilename, ADescription: Ansistring) : Boolean;
var
  psl : IShellLink;
  ppf : IPersistFile;
  wsz : PWideChar;
begin
  result:=false;
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,
  CLSCTX_inPROC_SERVER, IID_IShellLinkA, psl)) then
  begin
    psl.SetPath(PAnsiChar(AFilename));
    psl.SetDescription(PAnsiChar(ADescription));
    psl.SetWorkingDirectory(PAnsiChar(ExtractFilePath(AFilename)) ;);
    if SUCCEEDED(psl.QueryInterface(IPersistFile, ppf)) then
    begin
      GetMem(wsz, MAX_PATH*2);
      try
        MultiByteToWideChar(CP_ACP, 0, PAnsiChar(ALNKFilename), -1, wsz, MAX_PATH);
        ppf.Save(wsz, true);
        result:=true;
      finally
        FreeMem(wsz, MAX_PATH*2);
      end;
    end;
  end;
end;

nein das gibts in den zeilen die meldung ink. dat. AnsiChar und Char

Delphi-Quellcode:

psl.SetPath(PAnsiChar(AFilename));
    psl.SetDescription(PAnsiChar(ADescription));
    psl.SetWorkingDirectory(PAnsiChar(ExtractFilePath(AFilename)));

[DeddyH]

Dann muss ich mich leider ausklinken, da ich kein Delphi 2009 habe und nur noch herumraten könnte.

[Sir K]

trotzdem danke für die bisherige Hilfe xD

Gruß
Sir K

[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.

[Klaus01]

Laut msdn kann IShellLink Ansi und UniCode.

Delphi-Quellcode:

function CreateLink(const AFilename, ALNKFilename, ADescription: string) : Boolean; 
var 
  psl : IShellLink; 
  ppf : IPersistFile; 
begin 
  result:=false; 
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil, 
  CLSCTX_inPROC_SERVER, IID_IShellLinkA, psl)) then 
  begin 
    psl.SetPath(PWideChar(AFilename)); 
    psl.SetDescription(PWideChar(ADescription)); 
    psl.SetWorkingDirectory(PWideChar(ExtractFilePath(AFilename)) ;); 
    if SUCCEEDED(psl.QueryInterface(IPersistFile, ppf)) then 
    begin 
      ppf.Save(PWideChar(ALNKFileName, true); 
      // das result := true sollte noch irgendwo untergebracht werden.
    end; 
  end; 
end;

Weil, mkinzler hatte mal in einem Thread geschrieben:
Delphi2009 String = UniCode <> WideString

Dies ist auch mein letzter Versuch, ich habe auch kein Delphi2009 zur Verfügung.

Grüße
Klaus

[Sir K]

geht leider auch nicht
trotzdem Danke xD

Gruß
Sir K

[Micha88]

Folgende Funktion funktioniert unter RAD 2009 einwandfrei, benutze ich selber:

Delphi-Quellcode:

function CreateLink(const AFilename, ALNKFilename,
ADescription: AnsiString) : Boolean;
var
  psl : IShellLink;
  ppf : IPersistFile;
  wsz : PWideChar;
begin
  result:=false;
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,
  CLSCTX_inPROC_SERVER, IID_IShellLinkA, psl)) then
  begin
    psl.SetPath(PChar(AFilename));
    psl.SetDescription(PChar(ADescription));
    psl.SetWorkingDirectory(PChar(ExtractFilePath(AFilename)));
    if SUCCEEDED(psl.QueryInterface(IPersistFile, ppf)) then
    begin
      GetMem(wsz, MAX_PATH*2);
      try
        MultiByteToWideChar(CP_ACP, 0, PAnsiChar(ALNKFilename),
        -1, wsz, MAX_PATH);
        ppf.Save(wsz, true);
        result:=true;
      finally
        FreeMem(wsz, MAX_PATH*2);
      end;
    end;
  end;
end;

Aufruf:

Delphi-Quellcode:

 CreateLink('C:\TEST.exe', // Ziel
 vDesktopPfad + '\' + 'TEST.lnk', // Speicherort der verknüpfung
 'Das ist eine Testbeschreibung zu TEST.exe'); // Verknüpfungs Beschreibung

[BlueStarHH]

Die Lösung aus Betrag #19 funktioniert zwar, ist aber nicht Unicode fähig. Die Lösung aus Beitrag #17 ist Unicode fähig. Damit diese funktioniert, muss IID_IShellLinkA durch IID_IShellLinkW ersetzt werden.