파워러브 델파이 97년 7월호에서 가져왔습니다.

unit Link;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Ole2, Oleauto, ShellAPI, ShlObj;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;

    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    procedure MakeLink(Location : Word);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure CreateShellLink(sDesc,
                          sLinkToFileName,
                          sStartIn,
                          sArguments,
                          sIconPath,
                          sLinkName : String;
                          iIconIndex : Integer);
var
  sl : IShellLink;
  ppf : IPersistFile;
  wcLinkName : Array[0..MAX_PATH] of WideChar;
begin
  OleCheck(CoInitialize(nil));
  OleCheck(

    CoCreateInstance(CLSID_ShellLink, nil,
      CLSCTX_INPROC_SERVER, IID_IShellLink, sl)
  );

  OleCheck(sl.QueryInterface(IID_IPersistFile, ppf));

  OleCheck(sl.SetDescription(PChar(sDesc)));
  OleCheck(sl.SetPath(PChar(sLinkToFileName)));
  OleCheck(sl.SetWorkingDirectory(PChar(sStartIn)));
  OleCheck(sl.SetArguments(PChar(sArguments)));
  OleCheck(sl.SetIconLocation(PChar(sIconPath), iIconIndex));

  MultiByteToWideChar(CP_ACP, 0, PChar(sLinkName), -1,

    wcLinkName, MAX_PATH);

  OleCheck(ppf.Save(wcLinkName, true));

  CoUninitialize;
end;

procedure GetFolderPath(var sPath : String; iFolder : Integer);
var
  iID : PItemIDList;
  szPath : PChar;
begin
  szPath := StrAlloc(MAX_PATH);
  if SHGetSpecialFolderLocation(Application.Handle, iFolder, iID)
     = NOERROR then
  begin
    SHGetPathFromIDList(iID, szPath);
    sPath := szPath;

  end;
  StrDispose(szPath);
end;

function IconOfFile(const FileName : String; IconID : Integer) : THandle;
// 파일의 아이콘을 얻어내는 함수.
// IconID = SHGFI_LARGEICON : 32X32, SHGFI_SMALLICON : 16X16
var
  SHFileInfo : TSHFileInfo;
begin
  SHGetFileInfo(PChar(FileName), 0, SHFileInfo, SizeOf(SHFileInfo),
    IconID or SHGFI_ICON);
  Result := SHFileInfo.hIcon;
end;

procedure TForm1.MakeLink(Location : Word);

var
  sDeskTopPath, sLinkPath : String;
begin
  if OpenDialog1.FileName = '' then Exit;
  GetFolderPath(sDeskTopPath, Location);
  sLinkPath := sDeskTopPath + '\' +
    ExtractFileName(OpenDialog1.FileName) + '.lnk';

  CreateShellLink('',
                  OpenDialog1.FileName,
                  ExtractFilePath(OpenDialog1.FileName),
                  Edit1.Text,
                  OpenDialog1.FileName,
                  sLinkPath,

                  0);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Label2.Caption := ExtractFileName(OpenDialog1.FileName);
    Image1.Picture.Icon.Handle
      := IconOfFile(OpenDialog1.FileName, SHGFI_LARGEICON);
  end
  else
  begin
    OpenDialog1.FileName := '';
    Label2.Caption := '';
    Image1.Picture.Assign(nil);

  end;
end;

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

procedure TForm1.Button3Click(Sender: TObject);
begin
  MakeLink(CSIDL_PROGRAMS);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  MakeLink(CSIDL_STARTMENU);
end;

end.