1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77:
| unit uLinkFile;
interface
function LinkFileExists(ID: Integer; var LinkPath: String): Boolean; function LinkFile(ID: Integer; Link: Boolean; Param: String): Boolean;
implementation
uses Windows, ComObj, ActiveX, SysUtils, Shlobj;
function SpecialDirectory(ID: Integer): String; var pidl : PItemIDList; Path : PChar; begin if SUCCEEDED(SHGetSpecialFolderLocation(0, ID, pidl)) then begin Path := StrAlloc(max_path); SHGetPathFromIDList(pidl, Path); Result := String(Path); if Result[Length(Result)] <> '\' then Result := Result + '\'; end else Result := ''; end;
procedure CreateShortCut(ShortCut, Application, Parameters, WorkDir: String; SW_State: Integer; IconFile: String; IconIndex: Byte); var SCObject: IUnknown; SCSLink: IShellLink; SCPFile: IPersistFile; WFName: WideString; begin SCObject := CreateComObject(CLSID_ShellLink); SCSLink := SCObject as IShellLink; SCPFile := SCObject as IPersistFile; with SCSLink do begin SetPath(PChar(Application)); SetArguments(PChar(Parameters)); SetWorkingDirectory(PChar(WorkDir)); SetShowCmd(SW_State); SetIconLocation(PChar(IconFile), IconIndex); end; WFName := ShortCut; SCPFile.Save(PWChar(WFName), False); end;
function LinkFileExists(ID: Integer; var LinkPath: String): Boolean; begin LinkPath := SpecialDirectory(ID) + ExtractFileName(ChangeFileExt(ParamStr(0), '.lnk')); Result := FileExists( LinkPath ); end;
function LinkFile(ID: Integer; Link: Boolean; Param: String): Boolean; var LinkPath: String; begin Result := LinkFileExists(ID, LinkPath); if Link then begin if not FileExists(LinkPath) then CreateShortCut(LinkPath, ParamStr(0), Param, ExtractFilePath(ParamStr(0)), SW_SHOWNORMAL, ParamStr(0), 0); end else DeleteFile(LinkPath); end; |