Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 86 | daniel-mar | 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. |