Listing 21


unit ShellLink;

interface

uses
  Windows, SysUtils, Classes, Menus, ShlObj, Ole2, CommCtrl;

type TShellLinkInfo = record
       Error : Boolean;
       LinkName : string[255];
       Description : string[225];
       FileName : string[225];
       WorkingDirectory : string[225];
       Arguments : string[225];
       WindowState : Integer;
       HotKey : TShortCut;
       IconFileName : string[225];
       IconIndex : Integer;
     end;

function GetHotKey(AHotKey: Word): TShortCut;
function SetHotKey(AHotKey: TShortCut): Word;
function CreateShellLink(ShellLinkInfo: TShellLinkInfo): Boolean;
function GetShellLinkInfo(LinkName: string): TShellLinkInfo;

implementation

function GetHotKey(AHotKey: Word): TShortCut;
const
  Sh: array[Boolean] of TShiftState = ([], [ssShift]);
  Ct: array[Boolean] of TShiftState = ([], [ssCtrl]);
  Al: array[Boolean] of TShiftState = ([], [ssAlt]);
var
  Shift: TShiftState;
begin
  Shift := Sh[(Hi(AHotKey) and HOTKEYF_SHIFT = HOTKEYF_SHIFT)]
          + Ct[(Hi(AHotKey) and HOTKEYF_CONTROL = HOTKEYF_CONTROL)]
          + Al[(Hi(AHotKey) and HOTKEYF_ALT = HOTKEYF_ALT)] ;
  result := ShortCut(Lo(AHotKey), Shift);
end;

function SetHotKey(AHotKey: TShortCut): Word;
var
  Key: Word;
  Shift: TShiftState;
begin
  ShortCutToKey(AHotKey, Key, Shift);
  Key := Swap(Key);
  if ssShift in Shift then Key := Key + HOTKEYF_SHIFT;
  if ssCtrl in Shift then Key := Key + HOTKEYF_CONTROL;
  if ssAlt in Shift then Key := Key + HOTKEYF_ALT;
  Key := Swap(Key);
  result := Key;
end;

function CreateShellLink(ShellLinkInfo: TShellLinkInfo): Boolean;
var HRes: HResult;
    Link: IShellLink;
    PerFile: IPersistFile;
    str: string;
    Buffer: array[0..255] of Char;
    HotKey: Word;
    Shift: TShiftState;
    Size: Integer;
    W: PWideChar;

begin
result:=True;

Size:=(Length(ShellLinkInfo.LinkName)+1) * sizeof(WideChar);
GetMem(W, Size);
StringToWideChar(ShellLinkInfo.LinkName, W, Size);

HRes:=CoInitialize(nil);
HRes:=CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLink, Link);
if not Succeeded(HRes) then result:=False;

Link.AddRef;

HRes:=Link.QueryInterface(IID_IPersistFile, PerFile);
if not Succeeded(HRes) then result:=False;

//Beschreibung
StrPCopy(Buffer, ShellLinkInfo.Description);
Link.SetDescription(@Buffer);

//Ziel
StrPCopy(Buffer, ShellLinkInfo.FileName);
Link.SetPath(@Buffer);

//Arbeitsverzeichnis
StrPCopy(Buffer, Copy(ExtractFilePath(ShellLinkInfo.FileName), 1, Length(ExtractFilePath(ShellLinkInfo.FileName))-1));
Link.SetWorkingDirectory(@Buffer);

//Argumente
StrPCopy(Buffer, ShellLinkInfo.Arguments); //übergeben eines Parameterstrings
Link.SetArguments(@Buffer);

//FensterStatus
Link.SetShowCmd(ShellLinkInfo.WindowState); //SW_SHOWNORMAL, SW_SHOWMINNOACTIVE, SW_SHOWMAXIMIZED

//HotKey
Link.SetHotKey(SetHotKey(ShellLinkInfo.HotKey));

//Icon
StrPCopy(Buffer, ShellLinkInfo.IconFileName);
Link.SetIconLocation(@Buffer, ShellLinkInfo.IconIndex); //Bsp.: 0 = erstes (also das Programmicon) der Resource

HRes:=PerFile.Save(W, False);
if not Succeeded(HRes) then result:=False;

Link.Release;
PerFile.Release;
CoUninitialize;

FreeMem(W, Size);
end;

function GetShellLinkInfo(LinkName: string): TShellLinkInfo;
var HRes: HResult;
    Link: IShellLink;
    PerFile: IPersistFile;
    Buffer: array[0..255] of Char;
    IntBuffer: Integer;
    WordBuffer: Word;
    Size: Integer;
    W: PWideChar;
    Data: TWin32FindData;

begin
result.Error:=False;

Size:=(Length(LinkName)+1) * sizeof(WideChar); GetMem(W, Size);
StringToWideChar(LinkName, W, Size);

HRes := CoInitialize(nil);
HRes := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLink, Link);
if not Succeeded(HRes) then result.Error:=True;

HRes:=Link.QueryInterface(IID_IPersistFile, PerFile);
if not Succeeded(HRes) then result.Error:=True;

HRes := PerFile.Load(W, STGM_READ);
if not Succeeded(HRes) then result.Error:=True;

result.LinkName:=LinkName;

//Beschreibung
Link.GetDescription(@Buffer, MAX_PATH-5);
result.Description := StrPas(Buffer);

//Ziel
Link.GetPath(@Buffer, MAX_PATH-5, Data, SLGP_UNCPRIORITY);
result.FileName := StrPas(Buffer);

//Arbeitsverzeichnis
Link.GetWorkingDirectory(@Buffer, MAX_PATH-5);
result.WorkingDirectory := StrPas(Buffer);

//Argumente
Link.GetArguments(@Buffer, MAX_PATH-5);
result.Arguments := StrPas(Buffer);

//FensterStatus
Link.GetShowCmd(IntBuffer); //SW_SHOWNORMAL, SW_SHOWMINNOACTIVE, SW_SHOWMAXIMIZED
result.WindowState := IntBuffer;

//HotKey
Link.GetHotKey(WordBuffer);
result.HotKey := GetHotKey(WordBuffer);

//Icon
Link.GetIconLocation(@Buffer, MAX_PATH-5, IntBuffer);
result.IconFileName := StrPas(Buffer);
result.IconIndex := IntBuffer;

Link.Release;
PerFile.Release;
CoUninitialize;

FreeMem(W, Size);
end;

end.

Zurück zur Hauptseite