Subversion Repositories delphiutils

Rev

Go to most recent revision | Blame | Last modification | View Log | RSS feed

  1. program Shortcut;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils, ShlObj, ActiveX, ComObj, Windows;
  7.  
  8. // http://www.delphi-library.de/viewtopic.php?t=20516
  9. function ExpandEnvStr(const szInput: string): string;
  10. const
  11.   MAXSIZE = 32768; // laut PSDK sind 32k das Maximum
  12. begin
  13.   SetLength(Result, MAXSIZE);
  14.   SetLength(Result, ExpandEnvironmentStrings(pchar(szInput),
  15.     @Result[1],length(Result))-1); //-1 um abschließendes #0 zu verwerfen
  16. end;
  17.  
  18. var
  19.   IObject : IUnknown;
  20.   ISLink : IShellLink;
  21.   IPFile : IPersistFile;
  22.   TargetName : String;
  23.   LinkName : WideString;
  24.  
  25. // Ref: http://delphi.about.com/od/windowsshellapi/a/create_lnk.htm
  26. begin
  27.   If ParamCount <> 2 then
  28.   begin
  29.     WriteLn('Usage: SHORTCUT.EXE <source> <dest>');
  30.     WriteLn('');
  31.   end
  32.   else
  33.   begin
  34.     CoInitialize(nil);
  35.  
  36.     TargetName := ExpandEnvStr(ParamStr(1));
  37.  
  38.     IObject := CreateComObject(CLSID_ShellLink);
  39.     ISLink := IObject as IShellLink;
  40.     IPFile := IObject as IPersistFile;
  41.  
  42.     with ISLink do
  43.     begin
  44.       SetPath(pChar(TargetName)) ;
  45.       SetWorkingDirectory(pChar(ExtractFilePath(TargetName))) ;
  46.     end;
  47.  
  48.     LinkName := ExpandEnvStr(ParamStr(2));
  49.     IPFile.Save(PWChar(LinkName), false);
  50.  
  51.     CoUninitialize;
  52.   end;
  53. end.
  54.