unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, System.ComponentModel, Borland.Vcl.StdCtrls,
  System.Text, //StringBuilder
  ShlObj,  //IShellLink
  ComObj,  //CreateComObject
  ActiveX, //IPersistFile
  CommCtrl, //HOTKEYF_CONTROL i HOTKEYF_ALT
  System.Runtime.InteropServices; //Marshal

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TParametrySkrotu = record
    sciezkaPliku,argumenty,katalogRoboczy,opis,sciezkaIkony :String;
    rodzajOkna,numerIkony :Integer;
    klawiszSkrotu :Char;
  end;

type
  IUnknown = IInterface;
  IShellLink = IShellLinkW;

var
  Form1: TForm1;

implementation

{$R *.nfm}

function Katalog_Windows :String;
var nazwaKatalogu :StringBuilder;
begin
nazwaKatalogu:=StringBuilder.Create(MAX_PATH);
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,$0024,False);
Result:=nazwaKatalogu.ToString;
end;

function Katalog_System :String;
var nazwaKatalogu :StringBuilder;
begin
nazwaKatalogu:=StringBuilder.Create(MAX_PATH);
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,$0025,False);
Result:=nazwaKatalogu.ToString;
end;

function Katalog_MojeDokumenty :String;
var nazwaKatalogu :StringBuilder;
begin
nazwaKatalogu:=StringBuilder.Create(MAX_PATH);
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,CSIDL_PERSONAL,False);
Result:=nazwaKatalogu.ToString;
end;

function Katalog_AllUsers_Pulpit :String;
var nazwaKatalogu :StringBuilder;
begin
nazwaKatalogu:=StringBuilder.Create(MAX_PATH);
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,CSIDL_COMMON_DESKTOPDIRECTORY,False);
Result:=nazwaKatalogu.ToString;
end;

function Katalog_Pulpit :String;
var nazwaKatalogu :StringBuilder;
begin
nazwaKatalogu:=StringBuilder.Create(MAX_PATH);
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,CSIDL_DESKTOP,False);
Result:=nazwaKatalogu.ToString;
end;

procedure TworzSkrot(sciezkaLinku :String; parametrySkrotu :TParametrySkrotu);
{const
  HOTKEYF_SHIFT=1;
  HOTKEYF_ALT=4;
  HOTKEYF_CONTROL=2;
  HOTKEYF_EXT=8;}
var
  IObject : IUnknown;
  ISLink  : IShellLink;
  IPFile  : IPersistFile;
  GUID_CLSID_ShellLink :TGuid;
begin
  GUID_CLSID_ShellLink:=TGuid.Create($00021401,$0000,$0000,$C0,$00,$00,$00,$00,$00,$00,$46);
  IObject:=CreateComObject(GUID_CLSID_ShellLink);
  ISLink:=IObject as IShellLink;
  IPFile:=IObject as IPersistFile;

  //przygotowanie parametrow
  if parametrySkrotu.sciezkaPliku='' then raise Exception.Create('Brak nazwy pliku, do którego ma zostać utworzony skrót');
  if parametrySkrotu.katalogRoboczy='' then parametrySkrotu.katalogRoboczy:=ExtractFilePath(parametrySkrotu.sciezkaPliku);
  if parametrySkrotu.rodzajOkna=0 then parametrySkrotu.rodzajOkna:=SW_SHOWNORMAL; //nie dopuszczamy SW_HIDE=0 ze wzgledu na taka domyslna inicjacje
  parametrySkrotu.klawiszSkrotu:=UpCase(parametrySkrotu.klawiszSkrotu);

  //przygotowanie obiektu
  ISLink.SetPath(parametrySkrotu.sciezkaPliku);
  ISLink.SetWorkingDirectory(parametrySkrotu.katalogRoboczy);
  ISLink.SetArguments(parametrySkrotu.argumenty);
  if parametrySkrotu.opis<>'' then ISLink.SetDescription(parametrySkrotu.opis);
  ISLink.SetShowCmd(parametrySkrotu.rodzajOkna);
  if parametrySkrotu.sciezkaIkony<>'' then ISLink.SetIconLocation(parametrySkrotu.sciezkaIkony,parametrySkrotu.numerIkony);
  if parametrySkrotu.klawiszSkrotu<>'' then ISLink.SetHotKey(((HOTKEYF_ALT or HOTKEYF_CONTROL) shl 8) or Ord(parametrySkrotu.klawiszSkrotu));

  IPFile.Save(WideString(sciezkaLinku), False);
end;

procedure CzytajSkrot(sciezkaLinku :String; out parametrySkrotu :TParametrySkrotu);
var
  IObject : IUnknown;
  ISLink  : IShellLinkW;
  IPFile  : IPersistFile;

  informacjeOPliku :_WIN32_FIND_DATA;
  pstr :IntPtr;
  klawiszSkrotu :Word;
  GUID_CLSID_ShellLink :TGuid;
begin
  GUID_CLSID_ShellLink:=TGuid.Create($00021401,$0000,$0000,$C0,$00,$00,$00,$00,$00,$00,$46);
  IObject:=CreateComObject(GUID_CLSID_ShellLink);
  ISLink:=IObject as IShellLink;
  IPFile:=IObject as IPersistFile;

  IPFile.Load(WideString(sciezkaLinku),0);

  pstr:=Marshal.StringToHGlobalAuto('');
  ISLink.GetPath(pstr,MAX_PATH,informacjeOPliku,SLGP_UNCPRIORITY);
  parametrySkrotu.sciezkaPliku:=Marshal.PtrToStringAuto(pstr);

  ISLink.GetWorkingDirectory(pstr,MAX_PATH);
  parametrySkrotu.katalogRoboczy:=Marshal.PtrToStringAuto(pstr);

  ISLink.GetArguments(pstr,MAX_PATH);
  parametrySkrotu.argumenty:=Marshal.PtrToStringAuto(pstr);

  ISLink.GetDescription(pstr,MAX_PATH);
  parametrySkrotu.opis:=Marshal.PtrToStringAuto(pstr);

  ISLink.GetShowCmd(parametrySkrotu.rodzajOkna);

  ISLink.GetIconLocation(pstr,MAX_PATH,parametrySkrotu.numerIkony);
  parametrySkrotu.sciezkaIkony:=Marshal.PtrToStringAuto(pstr);

  ISLink.GetHotkey(klawiszSkrotu);
  parametrySkrotu.klawiszSkrotu:=Chr(klawiszSkrotu and 255);
end;

procedure TworzSkrotNaPulpicie(nazwaLinku :String; parametrySkrotu :TParametrySkrotu);
begin
nazwaLinku:=ExtractFileName(nazwaLinku); //na wszelki wypadek
TworzSkrot(Katalog_Pulpit+'\'+nazwaLinku,parametrySkrotu);
end;

procedure TForm1.Button1Click(Sender: TObject);
var parametrySkrotu :TParametrySkrotu;
begin
parametrySkrotu.sciezkaPliku:=Application.ExeName;
parametrySkrotu.katalogRoboczy:=ExtractFilePath(parametrySkrotu.sciezkaPliku);
parametrySkrotu.opis:=Form1.Caption;
parametrySkrotu.rodzajOkna:=SW_SHOWNORMAL;
parametrySkrotu.sciezkaIkony:=Application.ExeName;
parametrySkrotu.numerIkony:=0;
parametrySkrotu.klawiszSkrotu:='y';

TworzSkrot('Skrot.lnk',parametrySkrotu);
end;

procedure TForm1.Button2Click(Sender: TObject);
var parametrySkrotu :TParametrySkrotu;
begin
CzytajSkrot('Skrot.lnk',parametrySkrotu);

ShowMessage('Informacje o pliku skrótu'+#13+#13+
'Sciezka pliku: '+parametrySkrotu.sciezkaPliku+#13+
'Katalog roboczy: '+parametrySkrotu.katalogRoboczy+#13+
'Opis: '+parametrySkrotu.opis+#13+
'Ikona: '+parametrySkrotu.sciezkaIkony+', '+IntToStr(parametrySkrotu.numerIkony)+#13+
'Klawisz skrótu: Ctrl+Alt+'+parametrySkrotu.klawiszSkrotu);
end;

procedure TForm1.Button3Click(Sender: TObject);
var parametrySkrotu :TParametrySkrotu;
begin
parametrySkrotu.sciezkaPliku:=Application.ExeName;
parametrySkrotu.katalogRoboczy:=ExtractFilePath(parametrySkrotu.sciezkaPliku);
parametrySkrotu.opis:=Form1.Caption;
parametrySkrotu.rodzajOkna:=SW_SHOWNORMAL;
parametrySkrotu.sciezkaIkony:=Application.ExeName;
parametrySkrotu.numerIkony:=0;
parametrySkrotu.klawiszSkrotu:='y';

TworzSkrotNaPulpicie('Skrot.lnk',parametrySkrotu);
end;

end.
