Link til skriveboret

Den var grum. Jeg lytter med....

Hej Lolle

Det kræver en masse kode ... Så man skriver en mail til Jens@Borrisholt.com og beder om et program der kan det forespurgte ...

Jens B

Til delphidaner ->

function SpecialDirectory(const iID: Integer): string;
var
  aPath  : array[0..MAX_PATH] of Char;
  pilTemp: PItemIDList;
begin
  OleCheck(SHGetSpecialFolderLocation(0, iID, pilTemp));
  SHGetPathFromIDList(pilTemp, aPath);
  CoTaskMemFree(pilTemp);
  Result := string(aPath);
end;

Procedure CreateLink(Desc,Tohere:string);
var
  SL: IShellLink;
  PF: IPersistFile;
  LnkName: WideString;
begin
  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, SL));
  PF := SL as IPersistFile;
  OleCheck(SL.SetPath(PChar(Application.ExeName)));
  SL.SetWorkingDirectory(PChar(ExtractFileDir(Application.ExeName)));
  SL.SetDescription(PChar(Desc));
  LnkName := SpecialDirectory(CSIDL_DESKTOP) +\'\\\'+ Tohere;
  PF.Save(PWideChar(LnkName), True);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
if FileExists(SpecialDirectory(CSIDL_DESKTOP) + \'\\Link.lnk\') then SkrivbordLink.Checked := True;
end;

procedure TMainForm.SkrivbordLinkClick(Sender: TObject);
begin
if SkrivbordLink.Checked = True then begin
  CreateLink(\'Link v1.0\', \'Link.lnk\');
end else begin
  DeleteFile(SpecialDirectory(CSIDL_DESKTOP) + \'\\Link.lnk\');
end;
end;

N.B. SkrivbordLink.Checked := False ved start af prog ellers virker det ikke