Creating ShortCut to Desktop

List Program berikut adalah code untuk mengkopi folder aplikasi dan isinya serta membuatkan shortcut executable pada desktop. 🙂 usesnya apa rada lupa.. Yang penting di coba dulu dech.. 😀

uses ShlObj, ShellApi..

procedure CreateShortCut(Source : String);
var
   IObject : IUnknown;
   ISLink : IShellLink;
   IPFile : IPersistFile;
   PIDL : PItemIDList;
   InFolder : array[0..MAX_PATH] of Char;
   TargetName : String;
   LinkName : WideString;
begin
   TargetName := Source;

   IObject := CreateComObject(CLSID_ShellLink) ;
   ISLink := IObject as IShellLink;
   IPFile := IObject as IPersistFile;

   with ISLink do
   begin
     SetPath(pChar(TargetName)) ;
     SetWorkingDirectory(pChar(ExtractFilePath(TargetName))) ;
   end;

   SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL) ;
   SHGetPathFromIDList(PIDL, InFolder) ;

   LinkName := InFolder + '\App ShortCut.lnk';
   IPFile.Save(PWChar(LinkName), false) ;
end;

procedure TFTool.cxButton1Click(Sender: TObject);
var
  Fo      : TSHFileOpStruct;
  buffer  : array[0..4096] of char;
  p       : pchar;
begin
  MessageDlg('It will copy to PC which is Directory choose and create Shortcut ' +
    'in Desktop.',mtInformation,[mbOk],0);
  FillChar(Buffer, sizeof(Buffer), #0);
  p := @buffer;
  StrECopy(p,  'E:\PROJECTS\APP\*.*'); //Diambil contoh aplikasi berada di E:\PROJECTS\APP
  FillChar(Fo, sizeof(Fo), #0);

  Fo.Wnd    := Handle;
  Fo.wFunc  := FO_COPY;
  Fo.pFrom  := @Buffer;
  Fo.pTo    :='c:\app' ; // di Kopikan ke C.

  if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then
  begin
    MessageDlg('Copying was cancelled !',mtInformation,[mbok],0);
  end else
  begin
    CreateShortCut('c:\app\app.exe');
  end;
end;

Maka akan muncul di desktop App Shortcut sebagai shortcut app.exe. Selamat mencoba 🙂

Advertisements