//        ****************************************
//         TLink
//         Made by Mads Israelsen
//         13.06.2001
//         Copyright (c) 2001 by M. Israelsen
//        ****************************************

unit Link;

interface

uses
  Windows, ShellApi, ActiveX, ShlObj, ComObj, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TLink = class(TComponent)
  private
    fLinkFile : string;
    fLink : string;
    fDescription : string;
    fArguments : string;
    fWorkingDir : string;
    fHotKey : word;
    fIconFile : string;
    fIconIndex : integer;
    procedure SetLinkFile(const Value: String);
    procedure SetLink(const Value: String);
    procedure SetDescription(const Value: string);
    procedure SetHotKey(const Value: word);
    procedure SetIconFile(const Value: string);
    procedure SetIconIndex(const Value: integer);
    procedure SetWorkingDir(const Value: string);
  protected
    { Protected declarations }
  public
    Procedure CreateFile;
  published
    Property LinkFile : String read fLinkFile write SetLinkFile;
    Property Link : String read FLink write SetLink;
    Property Description : string read FDescription write SetDescription;
    Property Arguments : string read FDescription write SetDescription;
    Property WorkingDir : string read FWorkingDir write SetWorkingDir;
    Property HotKey : Word read FHotKey write SetHotKey;
    Property IconFile : string read FIconFile write SetIconFile;
    Property IconIndex : integer read FIconIndex write SetIconIndex;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('LPL Tools', [TLink]);
end;

{ TLink }

Procedure TLink.CreateFile;
var
//  anObj : IUnknown;
  ShLink : IShellLink;
  pFile : IPersistFile;
  WFile : WideString;
begin
  ShLink := CreateComObject(CLSID_ShellLink) as IShellLink;
  pFile := ShLink as IPersistFile;
  shLink.SetPath(Pchar(fLink));
  shLink.SetDescription(pchar(fDescription));
  shLink.SetArguments(pchar(fArguments));
  shLink.SetWorkingDirectory(pchar(fWorkingDir));
  shLink.SetIconLocation(pchar(fIconFile), fIconIndex);
  shLink.SetHotkey(fHotKey);
  WFile := fLinkFile;
  pFile.Save(PWchar(wFile), false);
end;

procedure TLink.SetLinkFile(const Value: String);
var
//  anObj : IUnknown;
  ShLink : IShellLink;
  pFile : IPersistFile;
  WFile : WideString;
  WinFD : TWin32FindData;
  temp : Pchar;
begin
  fLinkFile := Value;
  ShLink := CreateComObject(CLSID_ShellLink) as IShellLink;
  pFile := ShLink as IPersistFile;
  WFile := fLinkFile;
  pFile.Load(PWChar(Wfile), 0);
  temp := nil;
  shLink.GetPath(temp, $FF, WinFD , SLGP_UNCPRIORITY);
  If temp = nil then exit;
  fLinkFile := temp;
  shlink.GetDescription(temp, $FF);
  fDescription := temp;
  shLink.GetArguments(temp, $FF);
  fArguments := temp;
  shLink.GetWorkingDirectory(temp, $FF);
  fWorkingDir := temp;
  shLink.GetIconLocation(temp, $FF, fIconIndex);
  fIconFile := temp;
  shLink.GetHotkey(fHotkey);
end;

procedure TLink.SetLink(const Value: String);
begin
  FLink := Value;
end;

procedure TLink.SetDescription(const Value: string);
begin
  FDescription := Value;
end;

procedure TLink.SetHotKey(const Value: word);
begin
  FHotKey := Value;
end;

procedure TLink.SetIconFile(const Value: string);
begin
  FIconFile := Value;
end;

procedure TLink.SetIconIndex(const Value: integer);
begin
  FIconIndex := Value;
end;

procedure TLink.SetWorkingDir(const Value: string);
begin
  FWorkingDir := Value;
end;

end.
