Subversion Repositories delphiutils

Rev

Blame | Last modification | View Log | RSS feed

  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     Memo1: TMemo;
  13.     Label1: TLabel;
  14.     Edit1: TEdit;
  15.     CheckBox1: TCheckBox;
  16.     Label2: TLabel;
  17.     Edit2: TEdit;
  18.     Label3: TLabel;
  19.     Edit3: TEdit;
  20.     Label4: TLabel;
  21.     procedure Button1Click(Sender: TObject);
  22.   private
  23.     procedure FixShortcut(linkdatei: string);
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.dfm}
  32.  
  33. uses
  34.   ShellApi, ActiveX, SHFolder, ShlObj, ComObj, ioUtils;
  35.  
  36. procedure TForm1.FixShortcut(linkdatei: string);
  37. var
  38.   UN: IUnknown;
  39.   SL: IShellLink;
  40.   PF: IPersistFile;
  41.   FD: TWin32FindData;
  42.   buf: array[0..MAX_PATH] of char;
  43.   x, y: string;
  44.   w: WideString;
  45.   SR: TSearchRec;
  46.   SEARCH_BEGIN: string;
  47.   REPLACE_BEGIN: string;
  48. begin
  49.   UN:=CreateComObject(CLSID_ShellLink);
  50.   SL:=UN as IShellLink;
  51.   PF:=UN as IPersistFile;
  52.   w:=linkdatei;
  53.   OleCheck(PF.Load(PwideChar(w),STGM_READ));
  54.   OleCheck(SL.GetPath(buf,MAX_PATH,FD,SLGP_UNCPRIORITY));
  55.   x := buf;
  56.  
  57.   SEARCH_BEGIN := Edit2.Text;
  58.   REPLACE_BEGIN := Edit3.Text;
  59.  
  60.   if SameText(SEARCH_BEGIN,Copy(x,1,Length(SEARCH_BEGIN))) then
  61.   begin
  62.     y := StringReplace(x,SEARCH_BEGIN,REPLACE_BEGIN,[rfIgnoreCase]);
  63.     if x <> y then
  64.     begin
  65.       memo1.lines.add(x+' => '+y);
  66.  
  67.       SL.SetPath(PChar(y));
  68.       SL.SetWorkingDirectory(PChar(ExtractFilePath(y)));
  69.  
  70.       // Write lnk file
  71.       OleCheck(PF.Save(PWideChar(w), false));
  72.     end;
  73.   end;
  74. end;
  75.  
  76. procedure TForm1.Button1Click(Sender: TObject);
  77. var
  78.   s: string;
  79.   so: TSearchOption;
  80. begin
  81.   if CheckBox1.Checked then so := TSearchOption.soAllDirectories else so := TSearchOption.soTopDirectoryOnly;
  82.   for s in TDirectory.GetFiles(Edit1.text, '*.lnk', so) do
  83.   begin
  84.     memo1.Lines.add(s);
  85.     FixShortcut(s);
  86.   end;
  87.   ShowMessage('Done');
  88. end;
  89.  
  90. end.
  91.