unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  ShlObj,  //IShellLink
  ComObj,  //CreateComObject
  ActiveX, //IPersistFile
  CommCtrl; //HOTKEYF_CONTROL i HOTKEYF_ALT


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;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function Katalog_Windows :String;
var nazwaKatalogu :array[0..MAX_PATH-1] of Char;
begin
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,$0024,False);
Result:=String(nazwaKatalogu);
end;

function Katalog_System :String;
var nazwaKatalogu :array[0..MAX_PATH-1] of Char;
begin
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,$0025,False);
Result:=String(nazwaKatalogu);
end;

function Katalog_MojeDokumenty :String;
var nazwaKatalogu :array[0..MAX_PATH-1] of Char;
begin
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,CSIDL_PERSONAL,False);
Result:=String(nazwaKatalogu);
end;

function Katalog_AllUsers_Pulpit :String;
var nazwaKatalogu :array[0..MAX_PATH-1] of Char;
begin
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,CSIDL_COMMON_DESKTOPDIRECTORY,False);
Result:=String(nazwaKatalogu);
end;

function Katalog_Pulpit :String;
var nazwaKatalogu :array[0..MAX_PATH-1] of Char;
begin
SHGetSpecialFolderPath(GetCurrentProcess,nazwaKatalogu,CSIDL_DESKTOP,False);
Result:=String(nazwaKatalogu);
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;
begin
  IObject:=CreateComObject(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(PChar(parametrySkrotu.sciezkaPliku));
  ISLink.SetWorkingDirectory(PChar(parametrySkrotu.katalogRoboczy));
  ISLink.SetArguments(PChar(parametrySkrotu.argumenty));
  if parametrySkrotu.opis<>'' then ISLink.SetDescription(PChar(parametrySkrotu.opis));
  ISLink.SetShowCmd(parametrySkrotu.rodzajOkna);
  if parametrySkrotu.sciezkaIkony<>'' then ISLink.SetIconLocation(PChar(parametrySkrotu.sciezkaIkony),parametrySkrotu.numerIkony);
  if parametrySkrotu.klawiszSkrotu<>'' then ISLink.SetHotKey(((HOTKEYF_ALT or HOTKEYF_CONTROL) shl 8) or Ord(parametrySkrotu.klawiszSkrotu));

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

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

  informacjeOPliku :_WIN32_FIND_DATA;
  cstr :array[0..MAX_PATH-1] of Char;
  klawiszSkrotu :Word;
begin
  IObject:=CreateComObject(CLSID_ShellLink);
  ISLink:=IObject as IShellLink;
  IPFile:=IObject as IPersistFile;

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

  ISLink.GetPath(cstr,MAX_PATH,informacjeOPliku,SLGP_UNCPRIORITY);
  parametrySkrotu.sciezkaPliku:=cstr;

  ISLink.GetWorkingDirectory(cstr,MAX_PATH);
  parametrySkrotu.katalogRoboczy:=cstr;

  ISLink.GetArguments(cstr,MAX_PATH);
  parametrySkrotu.argumenty:=cstr;

  ISLink.GetDescription(cstr,MAX_PATH);
  parametrySkrotu.opis:=cstr;

  ISLink.GetShowCmd(parametrySkrotu.rodzajOkna);

  ISLink.GetIconLocation(cstr,MAX_PATH,parametrySkrotu.numerIkony);
  parametrySkrotu.sciezkaIkony:=cstr;

  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.
